home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / program / misc / obrn-a_1.lha / oberon-a / src_upd1.lha / source / oc / OCH.mod < prev    next >
Text File  |  1995-07-25  |  65KB  |  1,957 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OCH.mod $
  4.   Description: Code selection for statements
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.26 $
  8.       $Author: fjc $
  9.         $Date: 1995/07/25 18:10:44 $
  10.  
  11.   Copyright © 1990-1993, ETH Zuerich
  12.   Copyright © 1993-1995, Frank Copeland
  13.   This module forms part of the OC program
  14.   See OC.doc for conditions of use and distribution
  15.  
  16.   Log entries are at the end of the file.
  17.  
  18. *************************************************************************)
  19.  
  20. <* STANDARD- *> <* MAIN- *> <*$ LongVars+ *>
  21.  
  22. MODULE OCH;
  23.  
  24. IMPORT SYS := SYSTEM, OCM, OCS, OCT, OCC, OCI, OCE, str := Strings;
  25.  
  26. (* --- Exported declarations ------------------------------------------ *)
  27.  
  28.  
  29. TYPE
  30.   LabelRange * = RECORD
  31.     low *, high *, label * : LONGINT
  32.   END; (* LabelRange *)
  33.  
  34.  
  35. (* --- Local declarations --------------------------------------------- *)
  36.  
  37.  
  38. CONST
  39.  
  40.   (* Symbols *)
  41.  
  42.   null = OCS.null; times = OCS.times; slash = OCS.slash; div   = OCS.div;
  43.   mod  = OCS.mod;  and   = OCS.and;   plus  = OCS.plus;  minus = OCS.minus;
  44.   or   = OCS.or;   eql   = OCS.eql;   neq   = OCS.neq;   lss   = OCS.lss;
  45.   leq  = OCS.leq;  gtr   = OCS.gtr;   geq   = OCS.geq;   not   = OCS.not;
  46.  
  47.   (* object modes *)
  48.   Var = OCM.Var; VarX = OCM.VarX; Ind = OCM.Ind; IndX = OCM.IndX;
  49.   RegI = OCM.RegI; RegX = OCM.RegX; Lab = OCM.Lab; LabI = OCM.LabI;
  50.   Abs = OCM.Abs; Con = OCM.Con; Push = OCM.Push; Pop = OCM.Pop;
  51.   Coc = OCM.Coc; Reg = OCM.Reg; Fld = OCM.Fld; LProc = OCM.LProc;
  52.   XProc = OCM.XProc; TProc = OCM.TProc; AProc = OCM.AProc; Mod = OCM.Mod;
  53.   RList = OCM.RList; VarArg = OCM.VarArg; LibCall = OCM.LibCall;
  54.   M2Proc = OCM.M2Proc; CProc = OCM.CProc; Typ = OCM.Typ;
  55.  
  56.   (* System flags *)
  57.  
  58.   OberonFlag = OCM.OberonFlag; M2Flag = OCM.M2Flag; CFlag = OCM.CFlag;
  59.   BCPLFlag = OCM.BCPLFlag; AsmFlag = OCM.AsmFlag;
  60.  
  61.   (* structure forms *)
  62.   Undef = OCT.Undef; Byte = OCT.Byte; Bool = OCT.Bool; Char = OCT.Char;
  63.   SInt = OCT.SInt; Int = OCT.Int; LInt = OCT.LInt; Real = OCT.Real;
  64.   LReal = OCT.LReal; Set = OCT.Set; String = OCT.String;
  65.   NilTyp = OCT.NilTyp; NoTyp = OCT.NoTyp; Pointer = OCT.Pointer;
  66.   ProcTyp = OCT.ProcTyp; Array = OCT.Array; DynArr = OCT.DynArr;
  67.   Record = OCT.Record; BSet = OCT.BSet; WSet = OCT.WSet;
  68.   PtrTyp = OCT.PtrTyp; AdrTyp = OCT.AdrTyp; BPtrTyp = OCT.BPtrTyp;
  69.   Word = OCT.Word; Longword = OCT.Longword; TagTyp = OCT.TagTyp;
  70.  
  71.   caseSet = {Char, SInt, Int, LInt};
  72.   uptrSet = {M2Flag..AsmFlag};
  73.   intSet = {SInt, Int, LInt};
  74.   byteSet = {Undef, Bool, Byte, Char, SInt, BSet};
  75.   wordSet = {Int, WSet, Word};
  76.   lwordSet =
  77.     { LInt, Real, LReal, Set, NilTyp, Pointer, ProcTyp,
  78.       PtrTyp, AdrTyp, BPtrTyp, Longword };
  79.   initSet = {Pointer, ProcTyp, PtrTyp, AdrTyp, BPtrTyp};
  80.  
  81.   (* CPU Registers *)
  82.  
  83.   D0 = 0; D1 = 1; D2 = 2; D7 = 7;
  84.   A0 = 8; A1 = 9; A2 = 10; A3 = 11; A4 = 12; A5 = 13; A6 = 14; A7 = 15;
  85.   BP = A4; FP = A5; SP = A7;
  86.   DataRegs = {D0 .. D7};
  87.   AdrRegs = {A0 .. A7};
  88.  
  89.   (* Data sizes *)
  90.  
  91.   B = 1; W = 2; L = 4;
  92.  
  93. VAR
  94.   returnFound : BOOLEAN;
  95.  
  96. (* --- Procedure declarations ----------------------------------------- *)
  97.  
  98.  
  99. (*------------------------------------*)
  100. PROCEDURE setCC (VAR x : OCT.Item; cc : LONGINT);
  101.  
  102. BEGIN (* setCC *)
  103.   x.typ := OCT.booltyp; x.mode := Coc; x.a0 := cc; x.a1 := 0; x.a2 := 0
  104. END setCC;
  105.  
  106. (*------------------------------------*)
  107. PROCEDURE FJ * (VAR loc : LONGINT);
  108.  
  109. BEGIN (* FJ *)
  110.   OCC.PutWord (OCC.BRA); OCC.PutWord (loc); loc := OCC.pc - 2
  111. END FJ;
  112.  
  113. (*------------------------------------*)
  114. PROCEDURE CFJ * (VAR x : OCT.Item; VAR loc : LONGINT);
  115.  
  116.   VAR op : LONGINT;
  117.  
  118. BEGIN (* CFJ *)
  119.   IF x.typ.form = Bool THEN
  120.     IF x.mode = Con THEN
  121.       IF x.a0 = 0 THEN setCC (x, OCC.F) ELSE setCC (x, OCC.T) END
  122.     ELSIF x.mode # Coc THEN
  123.       OCC.PutF1 (OCC.TST, B, x); OCI.Unload (x); setCC (x, OCC.NE)
  124.     END
  125.   ELSE
  126.     OCS.Mark (120); setCC (x, OCC.EQ)
  127.   END;
  128.   IF x.a0 # OCC.T THEN
  129.     IF x.a0 = OCC.F THEN op := OCC.BRA
  130.     ELSE op := OCC.Bcc + (OCC.invertedCC (x.a0) * 100H);
  131.     END;
  132.     OCC.PutWord (op); OCC.PutWord (x.a2); loc := OCC.pc - 2
  133.   ELSE
  134.     loc := x.a2
  135.   END;
  136.   OCC.FixLink (x.a1)
  137. END CFJ;
  138.  
  139. (*------------------------------------*)
  140. PROCEDURE BJ * (loc : LONGINT);
  141.  
  142.   VAR dest : LONGINT;
  143.  
  144. BEGIN (* BJ *)
  145.   dest := loc - OCC.pc - 2;
  146.   IF dest < -128 THEN OCC.PutWord (OCC.BRA); OCC.PutWord (dest)
  147.   ELSE OCC.PutWord (SYS.LOR (OCC.BRA, SYS.AND (dest, 0FFH)))
  148.   END
  149. END BJ;
  150.  
  151. (*------------------------------------*)
  152. PROCEDURE CBJ * (VAR x : OCT.Item; loc : LONGINT);
  153.  
  154.   VAR op, dest : LONGINT;
  155.  
  156. BEGIN (* CBJ *)
  157.   IF x.typ.form = Bool THEN
  158.     IF x.mode = Con THEN
  159.       IF x.a0 = 0 THEN setCC (x, OCC.F) ELSE setCC (x, OCC.T) END
  160.     ELSIF x.mode # Coc THEN
  161.       OCC.PutF1 (OCC.TST, B, x); OCI.Unload (x); setCC (x, OCC.NE)
  162.     END
  163.   ELSE
  164.     OCS.Mark (120); setCC (x, OCC.EQ)
  165.   END;
  166.   IF x.a0 # OCC.T THEN
  167.     IF x.a0 = OCC.F THEN op := OCC.BRA
  168.     ELSE op := OCC.Bcc + (OCC.invertedCC (x.a0) * 100H);
  169.     END;
  170.     dest := loc - OCC.pc - 2;
  171.     IF dest < -128 THEN OCC.PutWord (op); OCC.PutWord (dest)
  172.     ELSE OCC.PutWord (SYS.LOR (op, SYS.AND (dest, 0FFH)))
  173.     END
  174.   END;
  175.   OCC.FixLinkWith (x.a2, loc); OCC.FixLink (x.a1)
  176. END CBJ;
  177.  
  178. (*------------------------------------*)
  179. PROCEDURE ModulePrologue * ();
  180.  
  181.   VAR L1, L2 : LONGINT; label : OCT.Label;
  182.  
  183. BEGIN (* ModulePrologue *)
  184.   OCC.StartPrologue ();
  185.  
  186.   IF OCS.option [OCS.main] THEN
  187.     IF OCM.SmallData THEN
  188.       NEW (label, 32); COPY ("_LinkerDB", label^);
  189.       OCC.PutWord (49F9H);
  190.       OCC.PutLongRef (0, label)           (* LEA     _LinkerDB,A4      *)
  191.     ELSIF OCM.Resident THEN
  192.       (* Allocate memory for the data segment *)
  193.       OCC.PutLong (048E7F0C0H);           (* MOVEM.L D0-D3/A0-A1,-(A7) *)
  194.  
  195.       (* Call e.AllocMem ( (__BSSLEN + 1) * 4, {e.memClear} ) *)
  196.       NEW (label, 32); COPY ("__BSSLEN", label^);
  197.       OCC.PutWord (0203CH);
  198.       OCC.PutLongRef (0, label);          (* MOVE.L  #__BSSLEN,D0      *)
  199.       OCC.PutWord (05280H);               (* ADDQ.L  #1,D0             *)
  200.       OCC.PutWord (0E580H);               (* ASL.L   #2,D0             *)
  201.       OCC.PutWord (02600H);               (* MOVE.L  D0,D3             *)
  202.       OCC.PutWord (07201H);               (* MOVEQ.L #1,D1             *)
  203.       OCC.PutWord (04841H);               (* SWAP    D1                *)
  204.       OCC.PutLong (02C780004H);           (* MOVE.L  AbsExecBase,A6    *)
  205.       OCC.PutLong (04EAEFF3AH);           (* JSR     AllocMem(A6)      *)
  206.       OCC.PutWord (04A80H);               (* TST.L   D0                *)
  207.       OCC.PutWord (0662CH);               (* BNE     continue          *)
  208.       OCC.PutLong (02A6E0114H);           (* MOVE.L  114(A6),A5        *)
  209.       OCC.PutLong (04AAD00ACH);           (* TST.L   AC(A5)            *)
  210.       OCC.PutWord (0661AH);               (* BNE     bailout1          *)
  211.       OCC.PutLong (041ED005CH);           (* LEA     5C(A5),A0         *)
  212.       OCC.PutLong (04EAEFE80H);           (* JSR     WaitPort(A6)      *)
  213.       OCC.PutLong (041ED005CH);           (* LEA     5C(A5),A0         *)
  214.       OCC.PutLong (04EAEFE8CH);           (* JSR     GetMsg(A6)        *)
  215.       OCC.PutLong (0522E0127H);           (* ADDQ.B  #1,127(A6)        *)
  216.       OCC.PutWord (02240H);               (* MOVE.L  D0,A1             *)
  217.       OCC.PutLong (04EAEFE86H);           (* JSR     ReplyMsg(A6)      *)
  218.                                           (* bailout1:                 *)
  219.       OCC.PutLong (04CDF030FH);           (* MOVEM.L (A7)+,D0-D3/A0-A1 *)
  220.       OCC.PutWord (07014H);               (* MOVEQ   #14,D0            *)
  221.       OCC.PutWord (04E75H);               (* RTS                       *)
  222.                                           (* continue:                 *)
  223.       OCC.PutWord (02840H);               (* MOVE.L  D0,A4             *)
  224.       OCC.PutWord (02883H);               (* MOVE.L  D3,(A4)           *)
  225.       OCC.PutLong (049EC0004H);           (* LEA     4(A4),A4          *)
  226.       OCC.PutLong (04CDF030FH);           (* MOVEM.L (A7)+,D0-D3/A0-A1 *)
  227.     END;
  228.  
  229.     (* Push the address of the call to the cleanup code *)
  230.     OCC.PutWord (0487AH);
  231.     L1 := OCC.pc; OCC.PutWord (0);          (* PEA     ??(PC)            *)
  232.  
  233.     (* Call module Kernel initialisation code *)
  234.     IF ~OCM.Resident THEN
  235.       OCC.PutWord (07201H);                 (* MOVEQ   #1,D1             *)
  236.     END;
  237.     OCC.CallKernel (OCC.kInit);             (* Call    Kernel_?INIT      *)
  238.     IF ~OCM.Resident THEN
  239.       (* Check if we are already running *)
  240.       OCC.PutWord (04A01H);                 (* TST.B   D1                *)
  241.       L2 := OCC.pc; OCC.PutWord (06600H);   (* BNE     bailout2          *)
  242.     END;
  243.  
  244.     (* Branch to module initialisation code *)
  245.     IF OCM.SmallCode THEN
  246.       OCC.PutWord (OCC.BSR);
  247.       OCC.PutWordRef (0, OCT.InitLabel);    (* BSR     InitLabel         *)
  248.     ELSE
  249.       OCC.PutWord (OCC.JSR + 039H);
  250.       OCC.PutLongRef (0, OCT.InitLabel);    (* JSR     InitLabel         *)
  251.     END;
  252.  
  253.     (* Set return code to 0 and make clean exit *)
  254.     OCC.PutWord (07000H);                   (* MOVEQ   #0,D0             *)
  255.     OCC.PutWord (09138H);                   (* SUB.L   A0,A0             *)
  256.     OCC.PutWord (07200H);                   (* MOVEQ   #0,D1             *)
  257.     OCC.CallKernel (OCC.kHalt);             (* Call    Kernel_Halt       *)
  258.  
  259.     (* Fixup the cleanup code address pushed at the start *)
  260.     OCC.PatchWord (L1, OCC.pc - L1);
  261.  
  262.     IF OCM.Resident THEN (* Free memory for data segment *)
  263.       OCC.PutWord (02600H);                 (* MOVE.L  D0,D3             *)
  264.       OCC.PutLong (043ECFFFCH);             (* LEA     -4(A4),A1         *)
  265.       OCC.PutWord (02011H);                 (* MOVE.L  (A1),D0           *)
  266.       OCC.PutLong (02C780004H);             (* MOVE.L  AbsExecBase,A6    *)
  267.       OCC.PutLong (04EAEFF2EH);             (* JSR     FreeMem(A6)       *)
  268.       OCC.PutWord (02003H);                 (* MOVE.L  D3,D0             *)
  269.     ELSE
  270.       (* Branch to module cleanup code *)
  271.       IF OCM.SmallCode THEN
  272.         OCC.PutWord (OCC.BSR);
  273.         OCC.PutWordRef (0, OCT.EndLabel)    (* BSR     EndLabel          *)
  274.       ELSE
  275.         OCC.PutWord (OCC.JSR + 039H);
  276.         OCC.PutLongRef (0, OCT.EndLabel)    (* JSR     EndLabel          *)
  277.       END;
  278.  
  279.       (* Call module Kernel cleanup code *)
  280.       OCC.CallKernel (OCC.kEnd);            (* Call    Kernel_END        *)
  281.       OCC.PutWord (4E75H);                  (* RTS                       *)
  282.  
  283.       (* We are already running, so bail out with return code = 25 *)
  284.       OCC.PatchWord (L2, OCC.pc - L2 - 2);  (* bailout2:                 *)
  285.       OCC.PutWord (588FH);                  (* ADDQ    #4,A7             *)
  286.       OCC.PutWord (7019H);                  (* MOVEQ   #25,D0            *)
  287.     END;
  288.     OCC.PutWord (4E75H)                     (* RTS                       *)
  289.   ELSE
  290.     (* Set a return code of 20 and return immediately. *)
  291.     OCC.PutWord (7014H);                    (* MOVEQ   #20,D0            *)
  292.     OCC.PutWord (4E75H)                     (* RTS                       *)
  293.   END;
  294.  
  295.   OCC.EndCodeHunk ()
  296. END ModulePrologue;
  297.  
  298. (*------------------------------------*)
  299. PROCEDURE StartProcedure * (proc : OCT.Object);
  300.  
  301. BEGIN (* StartProcedure *)
  302.   IF OCC.level = 1 THEN OCC.StartCodeHunk (FALSE) END
  303. END StartProcedure;
  304.  
  305. (*------------------------------------*)
  306. PROCEDURE LoadBP (saveBP : BOOLEAN);
  307.  
  308. BEGIN (* LoadBP *)
  309.   IF saveBP THEN OCC.PutWord (2F0CH) END;       (* MOVE.L BP,-(SP)       *)
  310.   OCC.PutWord (49F9H);
  311.   OCC.PutLongRef (0, OCT.VarLabel)              (* LEA    Module_VAR, BP *)
  312. END LoadBP;
  313.  
  314. (*------------------------------------*)
  315. PROCEDURE CopyDynArray (adr : LONGINT; typ : OCT.Struct; dsize : LONGINT);
  316.  
  317.   VAR size, len, desc, ptr1, ptr2, tos, x : OCT.Item;
  318.       moveSize : INTEGER; moveWords, oddSize : BOOLEAN; R : OCC.RegState;
  319.  
  320.   (*------------------------------------*)
  321.   PROCEDURE DynArrSize (typ : OCT.Struct);
  322.  
  323.   BEGIN (* DynArrSize *)
  324.     IF typ.form = DynArr THEN
  325.       DynArrSize (typ.BaseTyp);
  326.       IF len.mode = Undef THEN
  327.         desc.mode := Var; desc.lev := OCC.level; desc.a0 := adr + typ.adr;
  328.         len.mode := Reg; len.a0 := D0; OCC.Move (L, desc, len);
  329.         desc.typ := OCT.linttyp; len.typ := OCT.linttyp
  330.       ELSE
  331.         IF desc.mode = Var THEN desc.a0 := adr + typ.adr;
  332.         ELSE desc.a1 := adr + typ.adr;
  333.         END;
  334.         OCE.Op (times, len, desc, TRUE)
  335.       END
  336.     ELSE
  337.       size.mode := Con; size.typ := OCT.linttyp; size.a0 := typ.size
  338.     END
  339.   END DynArrSize;
  340.  
  341. BEGIN (* CopyDynArray *)
  342.   IF OCS.pragma [OCS.saveRegs] OR OCS.pragma [OCS.saveAllRegs] THEN
  343.     OCS.Mark (345)
  344.   END;
  345.   R := OCC.regState; len.mode := Undef;
  346.  
  347.   (* load total length of dyn array *)
  348.   DynArrSize (typ);
  349.  
  350.   (* calculate size in bytes *)
  351.   oddSize := ODD (size.a0);
  352.   moveWords := ~oddSize & ((size.a0 MOD 4) # 0);
  353.   IF size.a0 > 1 THEN
  354.     OCE.Op (times, len, size, FALSE)
  355.   END;
  356.   IF oddSize THEN
  357.     x.mode := Con; x.a0 := 0; x.typ := OCT.inttyp;
  358.     OCC.Bit (OCC.BTST, x, len);                 (*    BTST   #0, <len>   *)
  359.     OCC.PutWord (6702H);                        (*    BEQ.S  1$          *)
  360.     OCC.PutF7 (OCC.ADDQ, L, 1, len)             (*    ADDQ.L #1, <len>   *)
  361.   END;                                          (* 1$                    *)
  362.   size := len;
  363.  
  364.   IF OCS.pragma [OCS.stackChk] THEN OCC.CallKernel (OCC.kStackChk) END;
  365.  
  366.   (* adjust stack pointer *)
  367.   tos.mode := Reg; tos.a0 := SP;
  368.   OCC.PutF5 (OCC.SUB, L, size, tos);            (*    SUBA.L <size>, A7  *)
  369.  
  370.   (* decrement counter *)
  371.   x.mode := Con; x.typ := OCT.inttyp;
  372.   IF ~oddSize THEN
  373.     (* adjust counter for copy loop *)
  374.     IF moveWords THEN x.a0 := 1 ELSE x.a0 := 2 END;
  375.     OCC.Shift (OCC.ASR, L, x, size);            (*    ASR.L  #?, <size>  *)
  376.   END;
  377.   OCC.PutF7 (OCC.SUBQ, L, 1, size);             (*    SUBQ.L #1, <size>  *)
  378.  
  379.   ptr1.mode := Ind; ptr1.a0 := adr; ptr1.a1 := 0; ptr1.a2 := -1;
  380.   ptr1.lev := OCC.level; ptr1.typ := OCT.notyp; ptr1.obj := NIL;
  381.   x := ptr1; x.mode := Var;
  382.   OCI.LoadAdr (ptr1); ptr1.mode := Pop;         (*    LEA    adr(A5), An *)
  383.   OCC.ForgetReg (ptr1.a0);
  384.   OCC.Move (L, tos, x);                         (*    MOVE.L A7, adr(A5) *)
  385.   OCC.GetAReg (ptr2, NIL);
  386.   OCC.Move (L, tos, ptr2);                      (*    MOVE.L A7, Am      *)
  387.   ptr2.mode := Pop;
  388.  
  389.   IF oddSize THEN moveSize := B
  390.   ELSIF moveWords THEN moveSize := W
  391.   ELSE moveSize := L
  392.   END;
  393.   OCC.Move (moveSize, ptr1, ptr2);              (* 2$ MOVE.? (An)+,(Am)+ *)
  394.   OCC.PutWord (OCC.DBF + size.a0);
  395.   OCC.PutWord (-4);                             (*    DBF    <size>, 2$  *)
  396.  
  397.   OCC.FreeRegs (R)
  398. END CopyDynArray;
  399.  
  400.  
  401. (*------------------------------------*)
  402. PROCEDURE StartProcBody * (proc : OCT.Object; dsize : LONGINT);
  403.  
  404.   CONST
  405.     (* Register numbers in *reverse* order. *)
  406.     D0 = 15; D1 = 14; D2 = 13; D7 = 8;
  407.     A0 = 7; A1 = 6; A2 = 5; A4 = 3; A5 = 2; A6 = 1;
  408.  
  409.   VAR
  410.     par : OCT.Object; x, y : OCT.Item; count : LONGINT;
  411.     usesA4, usesA5 : BOOLEAN; savedRegs : SET;
  412.  
  413. BEGIN (* StartProcBody *)
  414.   (*proc.a1 := OCC.pc;*)
  415.   OCC.StartProcedure (proc);
  416.  
  417.   IF OCS.pragma [OCS.entryExitCode] THEN
  418.  
  419.     IF OCS.pragma [OCS.stackChk] THEN
  420.       IF OCS.pragma [OCS.saveAllRegs] THEN
  421.         OCC.PutWord (2F00H)                           (* MOVE.L D0,-(A7)  *)
  422.       END;
  423.       x.mode := Con; x.a0 := dsize; x.typ := OCT.linttyp;
  424.       y.mode := Reg; y.a0 := 0; (* D0 *)
  425.       OCC.Move (L, x, y);                             (* MOVE.L #dsize,D0 *)
  426.       OCC.CallKernel (OCC.kStackChk);
  427.       IF OCS.pragma [OCS.saveAllRegs] THEN
  428.         OCC.PutWord (201FH)                           (* MOVE.L (A7)+,D0  *)
  429.       END;
  430.     END; (* IF stackChk *)
  431.  
  432.     usesA4 := ~OCS.pragma [OCS.longVars] & ~OCM.SmallData & ~OCM.Resident
  433.               & ( (proc.mode = XProc)
  434.                   OR ((proc.mode = TProc) (*& (proc.visible = OCT.Exp)*) ));
  435.     usesA5 := (OCC.level # 1) OR (dsize # 0) OR OCT.IsParam (proc.link);
  436.  
  437.     IF usesA4 THEN LoadBP (TRUE) END;
  438.  
  439.     IF usesA5 THEN
  440.       IF
  441.         (dsize > 0)
  442.         & (OCS.option [OCS.initialise] OR OCS.pragma [OCS.clearVars])
  443.       THEN
  444.         OCC.PutWord (4E55H); OCC.PutWord (0);   (*    LINK   A5,#0        *)
  445.  
  446.         (* Clear all procedure variables. *)
  447.         count := dsize DIV 4; (* clear longwords initially *)
  448.         IF count > 0 THEN
  449.           IF count < 5 THEN (* inline the loop *)
  450.             WHILE count > 0 DO
  451.               OCC.PutWord (42A7H);              (*    CLR.L  -(A7)        *)
  452.               DEC (count)
  453.             END;
  454.           ELSE
  455.             IF OCS.pragma [OCS.saveAllRegs] THEN
  456.               OCC.PutWord (2F00H)               (*    MOVE.L D0,-(A7)     *)
  457.             END;
  458.             OCC.PutWord (303CH);
  459.             OCC.PutWord (count - 1);            (*    MOVE.W #count-1,D0  *)
  460.             OCC.PutWord (42A7H);                (* 1$ CLR.L  -(A7)        *)
  461.             OCC.PutWord (OCC.DBF);
  462.             OCC.PutWord (-4);                   (*    DBF.W  D0,1$        *)
  463.             IF OCS.pragma [OCS.saveAllRegs] THEN
  464.               OCC.PutWord (201FH)               (*    MOVE.L (A7)+,D0     *)
  465.             END;
  466.           END
  467.         END;
  468.         IF (dsize MOD 4) # 0 THEN (* Assuming dsize is a multiple of 2 *)
  469.           OCC.PutWord (4267H)                   (*    CLR.W  -(A7)        *)
  470.         END
  471.       ELSE
  472.         OCC.PutWord (4E55H);
  473.         OCC.PutWord (-dsize);                   (*    LINK   A5,#<-dsize> *)
  474.       END
  475.     END; (* IF usesA5 *)
  476.  
  477.     IF OCS.pragma [OCS.saveRegs] OR OCS.pragma [OCS.saveAllRegs] THEN
  478.       savedRegs := {A6..A2,D7..D2};
  479.       IF OCS.pragma [OCS.saveAllRegs] THEN
  480.         savedRegs := savedRegs + {A0,A1,D0,D1}
  481.       END;
  482.       IF usesA4 THEN EXCL (savedRegs, A4) END;
  483.       IF usesA5 THEN EXCL (savedRegs, A5) END;
  484.       OCC.PutWord (48E7H);                    (* MOVEM.L savedRegs,-(A7) *)
  485.       OCC.PutWord (SYS.VAL (LONGINT, savedRegs))
  486.     END; (* IF saveRegs OR saveAllRegs *)
  487.  
  488.     IF OCS.pragma [OCS.copyArrays] THEN
  489.       par := proc.link;
  490.       WHILE par # NIL DO
  491.         (* code for dynamic array value parameters *)
  492.         IF (par.typ.form = DynArr) & (par.mode = Var) THEN
  493.           CopyDynArray (par.a0, par.typ, dsize)
  494.         END;
  495.         par := par.link
  496.       END
  497.     END; (* IF copyArrays *)
  498.   END; (* IF entryExitCode *)
  499.  
  500.   returnFound := FALSE
  501. END StartProcBody;
  502.  
  503. (*------------------------------------*)
  504. PROCEDURE EndProcBody *
  505.   (proc : OCT.Object; psize : INTEGER; L0 : LONGINT; vars : BOOLEAN);
  506.  
  507.   VAR op : OCT.Item; usesA4, usesA5 : BOOLEAN; savedRegs : SET;
  508.  
  509. BEGIN (* EndProcBody *)
  510.   IF OCS.pragma [OCS.entryExitCode] THEN
  511.     usesA4 := ~OCS.pragma [OCS.longVars] & ~OCM.SmallData & ~OCM.Resident
  512.               & ( (proc.mode = XProc)
  513.                   OR ((proc.mode = TProc) (*& (proc.visible = OCT.Exp)*) ));
  514.     usesA5 := (OCC.level # 1) OR vars OR OCT.IsParam (proc.link);
  515.     IF usesA4 THEN
  516.       (* Don't count return address, frame pointer or global var base *)
  517.       DEC (psize, 12)
  518.     ELSE
  519.       (* Don't count return address or frame pointer *)
  520.       DEC (psize, 8)
  521.     END;
  522.     (* Insert trap for missing RETURN in function procedures. *)
  523.     IF (proc.typ # OCT.notyp) & OCS.pragma [OCS.returnChk] THEN
  524.       IF returnFound THEN OCC.Trap (OCC.ReturnCheck)
  525.       ELSE OCS.Mark (335)
  526.       END
  527.     END;
  528.     OCC.FixLink (L0); (* Fix up RETURN branches *)
  529.     IF OCS.pragma [OCS.saveRegs] OR OCS.pragma [OCS.saveAllRegs] THEN
  530.       savedRegs := {D2..D7,A2..A6};
  531.       IF OCS.pragma [OCS.saveAllRegs] THEN
  532.         savedRegs := savedRegs + {D0,D1,A0,A1}
  533.       END;
  534.       IF usesA4 THEN EXCL (savedRegs, A4) END;
  535.       IF usesA5 THEN EXCL (savedRegs, A5) END;
  536.       OCC.PutWord (4CDFH);                     (* MOVEM.L (A7)+,savedRegs *)
  537.       OCC.PutWord (SYS.VAL (LONGINT, savedRegs))
  538.     END;
  539.     IF usesA5 THEN OCC.PutWord (4E5DH) END;     (* UNLK    A5             *)
  540.     IF usesA4 THEN OCC.PutWord (285FH) END;     (* MOVEA.L (A7)+, A4      *)
  541.     IF OCS.pragma [OCS.deallocPars] & (psize > 0) THEN
  542.       OCC.PutWord (2F57H); OCC.PutWord (psize); (* MOVE.L  (SP),psize(SP) *)
  543.       IF psize <= 8 THEN
  544.         op.mode := Reg; op.a0 := SP;
  545.         OCC.PutF7 (OCC.ADDQ, L, psize, op)      (* ADDQ    #<psize>,SP    *)
  546.       ELSE
  547.         OCC.PutWord (4FEFH); OCC.PutWord (psize)(* LEA     psize(SP),SP   *)
  548.       END
  549.     END;
  550.     OCC.PutWord (OCC.RTS);
  551.   END;
  552.  
  553.   IF OCC.level = 1 THEN OCC.EndCodeHunk () END
  554. END EndProcBody;
  555.  
  556. (*------------------------------------*)
  557. PROCEDURE StartModuleBody * (VAR dsize : LONGINT; VAR L0 : LONGINT);
  558.  
  559.   VAR
  560.     x, y, z : OCT.Item; modno : INTEGER; module : OCT.Module;
  561.     count : LONGINT; obj : OCT.Object; pushedModule : BOOLEAN;
  562.     name : ARRAY 256 OF CHAR;
  563.  
  564.   (*------------------------------------*)
  565.   PROCEDURE CmdsAndTypes ( obj : OCT.Object );
  566.  
  567.     VAR typ : OCT.Struct; len : LONGINT;
  568.  
  569.   BEGIN (* CmdsAndTypes *)
  570.     IF obj # NIL THEN
  571.       CmdsAndTypes (obj.left);
  572.  
  573.       IF obj.mode = Typ THEN
  574.         typ := obj.typ;
  575.         IF (typ # NIL) & (typ.form = Record) & (typ.sysflg = OberonFlag)
  576.         THEN
  577.           IF ~pushedModule THEN
  578.             OCC.PutWord (02F00H);              (* MOVE.L D0,-(A7)         *)
  579.             pushedModule := TRUE
  580.           END;
  581.           OCC.PutWord (02F17H);                (* MOVE.L (A7),-(A7)       *)
  582.           x.mode := Con; x.a0 := 0; x.typ := OCT.tagtyp;
  583.           x.label := typ.label;
  584.           OCC.PutF3 (OCC.PEA, x);              (* PEA    #Type descriptor *)
  585.           OCC.CallKernel (OCC.kRegisterType);  (* Call   RegisterType     *)
  586.         END
  587.       ELSIF (obj.mode = XProc) & (obj.visible = OCT.Exp)
  588.           & (obj.typ = OCT.notyp) & (~OCT.IsParam (obj.link))
  589.       THEN
  590.         IF ~pushedModule THEN
  591.           OCC.PutWord (02F00H);                (* MOVE.L D0,-(A7)         *)
  592.           pushedModule := TRUE
  593.         END;
  594.         OCC.PutWord (02F17H);                  (* MOVE.L (A7),-(A7)       *)
  595.         OCT.GetName (obj.name, name);
  596.         len := str.Length (name);
  597.         x.mode := Abs; x.a0 := len + 1; x.typ := OCT.linttyp;
  598.         OCC.PutF3 (OCC.PEA, x);                (* PEA    LEN(name)        *)
  599.         OCC.AllocString (name, len, x);
  600.         x.mode := Con; x.typ := OCT.stringtyp;
  601.         OCC.PutF3 (OCC.PEA, x);                (* PEA    name             *)
  602.         x.mode := Lab; x.a0 := 0; x.a1 := L; x.label := obj.label;
  603.         OCC.PutF3 (OCC.PEA, x);                (* PEA    command          *)
  604.         OCC.CallKernel (OCC.kRegisterCommand); (* Call   RegisterCommand  *)
  605.       END;
  606.  
  607.       CmdsAndTypes (obj.right)
  608.     END
  609.   END CmdsAndTypes;
  610.  
  611. BEGIN (* StartModuleBody *)
  612.   OCC.StartCodeHunk (TRUE);
  613.   IF ~OCM.SmallData & ~OCM.Resident & ~OCS.pragma [OCS.longVars] THEN
  614.     LoadBP (FALSE)
  615.   END;
  616.  
  617.   (* Check if module already initialised *)
  618.   x.mode := Var; x.lev := 0; x.a0 := dsize; OCC.PutF1 (OCC.TST, B, x);
  619.   (* If so, return *)
  620.   L0 := 0; y.mode := Coc; y.a0 := OCC.EQ; y.a1 := 0; y.a2 := 0;
  621.   y.typ := OCT.booltyp; CFJ (y, L0);
  622.  
  623.   (* Set initialisation flag *)
  624.   x.mode := Var; x.lev := 0; x.a0 := dsize; OCC.PutF3 (OCC.ST, x);
  625.  
  626.   IF OCC.GlobalPtrs () THEN
  627.     x.mode := Var; x.lev := 0; x.a0 := 0;
  628.     OCC.PutF3 (OCC.PEA, x);                  (* PEA    VARS              *)
  629.     x.mode := Con; x.a0 := 0; x.a1 := 0; x.typ := OCT.tagtyp;
  630.     x.label := OCT.GCLabel;
  631.     OCC.PutF3 (OCC.PEA, x);                  (* PEA    GC-Offsets        *)
  632.     OCC.CallKernel (OCC.kInitGC)             (* Call   Kernel_InitGC     *)
  633.   END;
  634.  
  635.   IF OCS.option [OCS.register] THEN
  636.  
  637.     (* Register the module, types and commands *)
  638.  
  639.     x.mode := Abs; x.a0 := str.Length (OCT.ModuleName) + 1;
  640.     x.typ := OCT.linttyp;
  641.     OCC.PutF3 (OCC.PEA, x);               (* PEA    LEN(ModuleName)       *)
  642.     x.mode := Con; x.a0 := 0; x.typ := OCT.stringtyp;
  643.     x.label := OCT.ConstLabel;
  644.     OCC.PutF3 (OCC.PEA, x);               (* PEA    #ModuleName           *)
  645.     OCC.CallKernel (OCC.kRegisterModule); (* Call   Kernel_RegisterModule *)
  646.     pushedModule := FALSE;
  647.     CmdsAndTypes (OCT.topScope.link);
  648.     IF pushedModule THEN
  649.       OCC.PutWord (0588FH)                (* ADDQ.L #4,A7                 *)
  650.     END
  651.   END;
  652.  
  653.   IF (dsize > 0) & ~OCM.Resident
  654.    & (OCS.option [OCS.initialise] OR OCS.pragma [OCS.clearVars])
  655.   THEN
  656.     OCC.GetAReg (x, NIL);
  657.     IF OCM.SmallData OR OCS.pragma [OCS.longVars] THEN
  658.       y.mode := Var; y.lev := 0; y.a0 := 0;
  659.       OCC.PutF2 (OCC.LEA, y, x.a0)           (*    LEA     Module_VAR,An *)
  660.     ELSE
  661.       y.mode := Reg; y.a0 := BP;
  662.       OCC.Move (L, y, x)                     (*    MOVE.L  A4,An         *)
  663.     END;
  664.     x.mode := Pop; count := dsize DIV 4;    (* clear longwords initially *)
  665.     IF count > 0 THEN
  666.       IF count < 5 THEN (* inline the loop *)
  667.         WHILE count > 0 DO OCC.PutF1 (OCC.CLR, L, x); DEC (count) END;
  668.       ELSE
  669.         IF count > 65536 THEN OCS.Mark (312); count := 65536 END;
  670.         z.mode := Con; z.a0 := count - 1; z.typ := OCT.inttyp;
  671.         OCC.GetDReg (y, NIL);
  672.         OCC.Move (W, z, y);                  (*    MOVE.W  #count,Dn     *)
  673.         OCC.PutF1 (OCC.CLR, L, x);           (* 1$ CLR.L   (An)+         *)
  674.         OCC.PutWord (OCC.DBF + y.a0);
  675.         OCC.PutWord (-4);                    (*    DBF.W   Dn,1$         *)
  676.         OCC.FreeReg (y)
  677.       END
  678.     END;
  679.     IF (dsize MOD 4) # 0 THEN (* Assuming dsize is a multiple of 2 *)
  680.       OCC.PutF1 (OCC.CLR, W, x)              (*    CLR.W   (An)+         *)
  681.     END;
  682.     OCC.FreeReg (x)
  683.   END;
  684.  
  685.   (* Increment dsize to account for initFlag variable *)
  686.   INC (dsize, OCM.BoolSize); IF ODD (dsize) THEN INC (dsize) END;
  687.  
  688.   IF OCT.nofGmod > 0 THEN (* Initialise imported modules *)
  689.     IF ~OCM.SmallData & ~OCM.Resident & ~OCS.pragma [OCS.longVars] THEN
  690.       (* Save variable base pointer *)
  691.       OCC.PutWord (2F0CH)                             (* MOVE.L BP,-(SP) *)
  692.     END;
  693.  
  694.     modno := 0;
  695.     WHILE modno < OCT.nofGmod DO
  696.       module := OCT.GlbMod [modno];
  697.       IF module.visible = OCT.Exp THEN
  698.         IF OCM.SmallCode THEN
  699.           OCC.PutWord (OCC.BSR); OCC.PutWordRef (0, module.label)
  700.         ELSE
  701.           OCC.PutWord (OCC.JSR + 039H); OCC.PutLongRef (0, module.label)
  702.         END;
  703.       END;
  704.       INC (modno)
  705.     END;
  706.  
  707.     IF ~OCM.SmallData & ~OCM.Resident & ~OCS.pragma [OCS.longVars] THEN
  708.       (* Restore variable base pointer *)
  709.       OCC.PutWord (285FH)                           (* MOVEA.L (A7)+, A4 *)
  710.     END
  711.   END
  712. END StartModuleBody;
  713.  
  714. (*------------------------------------*)
  715. PROCEDURE EndModuleBody * (dsize : LONGINT; L0 : LONGINT);
  716.  
  717.   VAR
  718.     x : OCT.Item; endProc : OCT.Object; modno : INTEGER;
  719.     module : OCT.Module;
  720.  
  721. BEGIN (* EndModuleBody *)
  722.   OCC.FixLink (L0);
  723.   OCC.PutWord (OCC.RTS);
  724.  
  725.   IF ~OCM.Resident THEN
  726.     NEW (endProc);
  727.     endProc.mode := XProc; endProc.a0 := 0; endProc.typ := OCT.notyp;
  728.     endProc.label := OCT.EndLabel;
  729.     OCC.StartProcedure (endProc);
  730.  
  731.     (* Clear initialisation flag *)
  732.     OCS.pragma [OCS.longVars] := TRUE;
  733.     x.mode := Var; x.lev := 0; x.a0 := dsize - 2; OCC.PutF3 (OCC.SF, x);
  734.  
  735.     IF OCT.nofGmod > 0 THEN (* Cleanup imported modules *)
  736.       modno := 0;
  737.       WHILE modno < OCT.nofGmod DO
  738.         module := OCT.GlbMod [modno];
  739.         IF module.visible = OCT.Exp THEN
  740.           IF OCM.SmallCode THEN
  741.             OCC.PutWord (OCC.BSR); OCC.PutWordRef (0, module.endLab)
  742.           ELSE
  743.             OCC.PutWord (OCC.JSR + 039H); OCC.PutLongRef (0, module.endLab)
  744.           END;
  745.         END;
  746.         INC (modno)
  747.       END
  748.     END;
  749.  
  750.     OCC.PutWord (OCC.RTS);
  751.   END;
  752.  
  753.   OCC.EndCodeHunk ()
  754. END EndModuleBody;
  755.  
  756. (*------------------------------------*)
  757. PROCEDURE CompareParLists * (x, y : OCT.Object);
  758.  
  759.   VAR xt, yt : OCT.Struct;
  760.  
  761. BEGIN (* CompareParLists *)
  762.   WHILE x # NIL DO
  763.     IF y # NIL THEN
  764.       xt := x.typ; yt := y.typ;
  765.       WHILE (xt.form = DynArr) & (yt.form = DynArr) DO
  766.         xt := xt.BaseTyp; yt := yt.BaseTyp
  767.       END;
  768.       IF x.mode # y.mode THEN
  769.         OCS.Mark (115)
  770.       ELSIF xt # yt THEN
  771.         IF (xt.form = ProcTyp) & (yt.form = ProcTyp) THEN
  772.           CompareParLists (xt.link, yt.link)
  773.         ELSE
  774.           OCS.Mark (115)
  775.         END
  776.       END;
  777.       y := y.link
  778.     ELSE OCS.Mark (116)
  779.     END;
  780.     x := x.link
  781.   END; (* WHILE *)
  782.   IF (y # NIL) & (y.mode <= Ind) & (y.a0 >= 0) THEN OCS.Mark (117) END
  783. END CompareParLists;
  784.  
  785. (*------------------------------------*)
  786. PROCEDURE Leng (VAR x : OCT.Item; L0 : LONGINT);
  787.  
  788.   VAR y : OCT.Item;
  789.  
  790. BEGIN (* Leng *)
  791.   IF x.mode = Push THEN y.mode := Abs; y.a0 := L0; OCC.PutF3 (OCC.PEA, y)
  792.   ELSE y.mode := Con; y.a0 := L0; y.typ := OCT.linttyp; OCC.Move (L, y, x)
  793.   END
  794. END Leng;
  795.  
  796. (*------------------------------------*)
  797. PROCEDURE DynArrBnd (
  798.   ftyp : OCT.Struct; VAR ap : OCT.Item; varpar : BOOLEAN);
  799.  
  800.   VAR
  801.     f : INTEGER; x, y, z, desc : OCT.Item; atyp : OCT.Struct;
  802.     adr : LONGINT; freeY : BOOLEAN;
  803.  
  804. BEGIN (* DynArrBnd *)
  805.   (* ftyp.form = DynArr *)
  806.   x.mode := Push; x.a0 := SP; atyp := ap.typ;
  807.   IF varpar & (ftyp.BaseTyp = OCT.bytetyp) THEN
  808.     IF atyp.form # DynArr THEN Leng (x, atyp.size)
  809.     ELSE
  810.       adr := atyp.adr; OCI.DescItem (desc, ap.desc, adr);
  811.       atyp := atyp.BaseTyp; freeY := FALSE;
  812.       IF atyp.form = DynArr THEN
  813.         OCC.GetDReg (y, NIL); OCC.Move (L, desc, y);
  814.         OCI.UpdateDesc (desc, adr); freeY := TRUE;
  815.         y.typ := OCT.linttyp;
  816.         REPEAT
  817.           OCI.DescItem (desc, ap.desc, atyp.adr);
  818.           OCE.Op (times, y, desc, FALSE);
  819.           atyp := atyp.BaseTyp
  820.         UNTIL atyp.form # DynArr;
  821.       ELSE
  822.         y := desc
  823.       END;
  824.       IF atyp.size > 1 THEN
  825.         z.mode := Con; z.a0 := atyp.size; z.typ := OCT.linttyp;
  826.         OCE.Op (times, y, z, FALSE)
  827.       END;
  828.       OCC.Move (L, y, x);
  829.       IF freeY THEN OCI.Unload (y) ELSE OCI.UnloadDesc (ap) END
  830.     END
  831.   ELSE
  832.     desc.mode := Undef;
  833.     LOOP
  834.       f := atyp.form;
  835.       IF f = Array THEN Leng (x, atyp.n)
  836.       ELSIF f = DynArr THEN
  837.         OCI.DescItem (desc, ap.desc, atyp.adr);
  838.         OCC.Move (L, desc, x); OCI.UpdateDesc (desc, atyp.adr)
  839.       ELSE OCS.Mark (66)
  840.       END;
  841.       ftyp := ftyp.BaseTyp; atyp := atyp.BaseTyp;
  842.       IF ftyp.form # DynArr THEN
  843.         IF ftyp # atyp THEN OCS.Mark (67) END;
  844.         EXIT
  845.       END
  846.     END; (* LOOP *)
  847.     OCI.UnloadDesc (ap)
  848.   END
  849. END DynArrBnd;
  850.  
  851. (*------------------------------------*)
  852. PROCEDURE ExtendStack (size : LONGINT);
  853.  
  854.   VAR sp, x : OCT.Item;
  855.  
  856. BEGIN (* ExtendStack *)
  857.   sp.mode := Reg; sp.a0 := SP;
  858.   IF ODD (size) THEN INC (size) END;
  859.   IF size <= 8 THEN
  860.     OCC.PutF7 (OCC.SUBQ, L, size, sp)
  861.   ELSE
  862.     x.mode := RegI; x.a0 := SP; x.a1 := -size;
  863.     OCC.PutF2 (OCC.LEA, x, sp.a0)
  864.   END
  865. END ExtendStack;
  866.  
  867. (*------------------------------------*)
  868. PROCEDURE moveBW (VAR src, dst : OCT.Item; extend : BOOLEAN);
  869.  
  870.   VAR x, zero : OCT.Item;
  871.  
  872. BEGIN (* moveBW *)
  873.   IF src.mode = Con THEN
  874.     OCC.Move (W, src, dst)
  875.   ELSE
  876.     IF ~extend THEN
  877.       zero.mode := Con; zero.a0 := 0; zero.typ := OCT.wordtyp;
  878.     END;
  879.     IF (dst.mode = Reg) & (dst.a0 IN DataRegs) THEN
  880.       IF ~extend THEN OCC.Move (W, zero, dst) END;
  881.       OCC.Move (B, src, dst);
  882.       IF extend THEN OCI.EXT (W, dst.a0) END
  883.     ELSE
  884.       IF extend THEN
  885.         OCI.Load (src); OCI.EXT (W, src.a0)
  886.       ELSE
  887.         x := src; OCC.GetDReg (src, NIL);
  888.         OCC.Move (W, zero, src); OCC.Move (B, x, dst); OCI.Unload (x)
  889.       END;
  890.       OCC.Move (W, src, dst)
  891.     END
  892.   END
  893. END moveBW;
  894.  
  895. (*------------------------------------*)
  896. PROCEDURE moveBL (VAR src, dst : OCT.Item; extend : BOOLEAN);
  897.  
  898.   VAR x, zero : OCT.Item;
  899.  
  900. BEGIN (* moveBL *)
  901.   IF src.mode = Con THEN
  902.     OCC.Move (L, src, dst)
  903.   ELSE
  904.     IF ~extend THEN
  905.       zero.mode := Con; zero.a0 := 0; zero.typ := OCT.wordtyp;
  906.     END;
  907.     IF (dst.mode = Reg) & (dst.a0 IN DataRegs) THEN
  908.       IF ~extend THEN OCC.Move (L, zero, dst) END;
  909.       OCC.Move (B, src, dst);
  910.       IF extend THEN OCI.EXT (W, dst.a0); OCI.EXT (L, dst.a0) END
  911.     ELSE
  912.       IF extend THEN
  913.         OCI.Load (src); OCI.EXT (W, src.a0); OCI.EXT (L, src.a0)
  914.       ELSE
  915.         x := src; OCC.GetDReg (src, NIL);
  916.         OCC.Move (L, zero, src); OCC.Move (B, x, src); OCI.Unload (x)
  917.       END;
  918.       OCC.Move (L, src, dst)
  919.     END
  920.   END
  921. END moveBL;
  922.  
  923. (*------------------------------------*)
  924. PROCEDURE moveWL (VAR src, dst : OCT.Item; extend : BOOLEAN);
  925.  
  926.   VAR x, zero : OCT.Item;
  927.  
  928. BEGIN (* moveWL *)
  929.   IF src.mode = Con THEN
  930.     OCC.Move (L, src, dst)
  931.   ELSE
  932.     IF ~extend THEN
  933.       zero.mode := Con; zero.a0 := 0; zero.typ := OCT.wordtyp;
  934.     END;
  935.     IF (dst.mode = Reg) & (dst.a0 IN DataRegs) THEN
  936.       IF ~extend THEN OCC.Move (L, zero, dst) END;
  937.       OCC.Move (W, src, dst);
  938.       IF extend THEN OCI.EXT (L, dst.a0) END
  939.     ELSE
  940.       IF extend THEN
  941.         OCI.Load (src); OCI.EXT (L, src.a0)
  942.       ELSE
  943.         x := src; OCC.GetDReg (src, NIL);
  944.         OCC.Move (L, zero, src); OCC.Move (W, x, src); OCI.Unload (x)
  945.       END;
  946.       OCC.Move (L, src, dst)
  947.     END
  948.   END
  949. END moveWL;
  950.  
  951. (*------------------------------------*)
  952. (*
  953.   Moves size bytes from src to dst.
  954. *)
  955. PROCEDURE moveBlock (VAR src, dst : OCT.Item; size : LONGINT);
  956.  
  957.   VAR
  958.     x, y : OCT.Item; numRegs, i, s : INTEGER; lw : LONGINT; R : SET;
  959.     useMOVEM, freeDst : BOOLEAN;
  960.  
  961. BEGIN (* moveBlock *)
  962.   freeDst := FALSE;
  963.   (* size must be even, but it may be zero *)
  964.   IF ODD (size) THEN OCS.Mark (957); INC (size) END;
  965.   IF size = 2 THEN OCC.Move (W, src, dst)
  966.   ELSIF size = 4 THEN OCC.Move (L, src, dst)
  967.   ELSIF size > 0 THEN
  968.     R := {D0 .. D7} - OCC.regState.regs; numRegs := 0; i := D0;
  969.     WHILE i <= D7 DO IF i IN R THEN INC (numRegs) END; INC (i) END;
  970.     IF (size MOD 4) = 2 THEN useMOVEM := ((numRegs * 2) >= size); s := W
  971.     ELSE useMOVEM := ((numRegs * 4) >= size); s := L
  972.     END;
  973.  
  974.     IF useMOVEM THEN
  975.       (* Calculate which registers are needed *)
  976.       numRegs := SHORT (size DIV s); i := D0;
  977.       WHILE numRegs > 0 DO
  978.         WHILE ~(i IN R) DO INC (i) END;
  979.         INC (i); DEC (numRegs)
  980.       END;
  981.       (* Discard the rest *)
  982.       WHILE i <= D7 DO EXCL (R, i); INC (i) END;
  983.       (* Reserve the registers *)
  984.       OCC.regState.regs := OCC.regState.regs + R;
  985.       FOR i := D0 TO D7 DO IF i IN R THEN OCC.ForgetReg (i) END END;
  986.       (* Finally ... *)
  987.       x.mode := RList; x.a0 := SYS.VAL (LONGINT, R);
  988.       OCC.Move (s, src, x);                        (* MOVEM.s <src>,Dx-Dy *)
  989.       OCC.Move (s, x, dst);                        (* MOVEM.s Dx-Dy,<dst> *)
  990.       (* Free registers. *)
  991.       OCC.regState.regs := OCC.regState.regs - R;
  992.     ELSE
  993.       OCI.LoadAdr (src); src.mode := Pop; OCC.ForgetReg (src.a0);
  994.       IF dst.mode = Push THEN
  995.         ExtendStack (size);
  996.         y.mode := Reg; y.a0 := dst.a0;
  997.         OCC.GetAReg (dst, NIL); OCC.Move (L, y, dst);
  998.         dst.mode := Pop; dst.a1 := 0;
  999.         freeDst := TRUE
  1000.       ELSE
  1001.         OCI.LoadAdr (dst); dst.mode := Pop; OCC.ForgetReg (dst.a0)
  1002.       END;
  1003.       lw := size DIV 4;
  1004.       IF lw > 65536 THEN
  1005.         x.mode := Con; x.a0 := lw; x.typ := OCT.linttyp;
  1006.         OCI.Load (x);                            (*    MOVE.L #<size>,Dc  *)
  1007.         OCC.Move (L, src, dst);                  (* 1$ MOVE.L (As)+,(Ad)+ *)
  1008.         OCC.PutF7 (OCC.SUBQ, L, 1, x);           (*    SUBQ.L #1,Dc       *)
  1009.         OCC.PutWord (66FAH);                     (*    BNE    1$          *)
  1010.       ELSIF lw > 1 THEN
  1011.         IF lw > 32768 THEN DEC (lw, 65536) END;
  1012.         x.mode := Con; x.a0 := lw - 1; x.typ := OCT.inttyp;
  1013.         OCI.Load (x);                            (*    MOVE.W #<size>,Dc  *)
  1014.         OCC.Move (L, src, dst);                  (* 1$ MOVE.L (As)+,(Ad)+ *)
  1015.         OCC.PutWord (OCC.DBF + x.a0);
  1016.         OCC.PutWord (-4)                         (*    DBF.W  Dc, 1$      *)
  1017.       ELSIF lw = 1 THEN
  1018.         OCC.Move (L, src, dst)
  1019.       END;
  1020.       IF (size MOD 4) = 2 THEN OCC.Move (W, src, dst) END;
  1021.       IF freeDst THEN OCC.FreeReg (dst) END
  1022.     END
  1023.   END
  1024. END moveBlock;
  1025.  
  1026. (*------------------------------------*)
  1027. PROCEDURE movePtr ( VAR src, dst : OCT.Item );
  1028.  
  1029.   VAR x : OCT.Item;
  1030.  
  1031. BEGIN (* movePtr *)
  1032.   IF (dst.typ.sysflg = BCPLFlag) & (src.typ.sysflg # BCPLFlag) THEN
  1033.     x := src; OCC.GetDReg (src, NIL);
  1034.     OCC.Move (L, x, src);                              (* MOVE.L src,Dx  *)
  1035.     x.mode := Con; x.a0 := 2; x.typ := OCT.linttyp;
  1036.     OCC.Shift (OCC.ASR, L, x, src);                    (* ASR.L  #2,Dx   *)
  1037.   ELSIF (dst.typ.sysflg # BCPLFlag) & (src.typ.sysflg = BCPLFlag) THEN
  1038.     x := src; OCC.GetDReg (src, NIL);
  1039.     OCC.Move (L, x, src);                              (* MOVE.L src,Dx  *)
  1040.     OCC.PutF5 (OCC.ADD, L, src, src);                  (* ADD.L  Dx,Dx   *)
  1041.     OCC.PutF5 (OCC.ADD, L, src, src);                  (* ADD.L  Dx,Dx   *)
  1042.   END;
  1043.   OCC.Move (L, src, dst)
  1044. END movePtr;
  1045.  
  1046. (*------------------------------------*)
  1047. PROCEDURE Assign * (VAR dst, src : OCT.Item; param : BOOLEAN);
  1048.  
  1049.   VAR f, g : INTEGER; L0, reg, op, s, vsz : LONGINT;
  1050.       y, z, tag, tdes : OCT.Item; p, q : OCT.Struct; R : OCC.RegState;
  1051.       R1 : SET; freeDst : BOOLEAN;
  1052.  
  1053.   (*------------------------------------*)
  1054.   PROCEDURE IntToReal ();
  1055.  
  1056.     VAR R : OCC.RegState; f : INTEGER;
  1057.  
  1058.   BEGIN (* IntToReal *)
  1059.     IF src.mode = Con THEN src.typ := OCT.linttyp END;
  1060.     f := src.typ.form;
  1061.     OCC.LoadRegParams1 (R, src);
  1062.     IF f = SInt THEN OCI.EXT (W, D0); f := Int END;
  1063.     IF f = Int THEN OCI.EXT (L, D0) END;
  1064.     OCC.CallKernel (OCC.kSPFlt);
  1065.     OCC.RestoreRegisters (R, src);
  1066.     OCC.Move (L, src, dst)
  1067.   END IntToReal;
  1068.  
  1069. BEGIN (* Assign *)
  1070.   IF dst.rdOnly THEN OCS.Mark (324) END;
  1071.   f := dst.typ.form; g := src.typ.form;
  1072.   IF dst.mode = Con THEN OCS.Mark (56) END;
  1073.   CASE f OF
  1074.     Undef :
  1075.     |
  1076.     Byte :
  1077.       IF (g = String) & (src.a1 <= 2) THEN
  1078.         src.a0 := src.a2; src.typ := OCT.chartyp; g := Char
  1079.       END;
  1080.       IF g IN byteSet THEN OCC.Move (B, src, dst)
  1081.       ELSE OCS.Mark (113)
  1082.       END
  1083.     |
  1084.     Word :
  1085.       IF (g = String) & (src.a1 <= 2) THEN
  1086.         src.a0 := src.a2; src.typ := OCT.chartyp; g := Char
  1087.       END;
  1088.       IF g IN wordSet THEN OCC.Move (W, src, dst)
  1089.       ELSIF g IN byteSet THEN moveBW (src, dst, g = SInt)
  1090.       ELSE OCS.Mark (113)
  1091.       END
  1092.     |
  1093.     Longword :
  1094.       IF (g = String) & (src.a1 <= 2) THEN
  1095.         src.a0 := src.a2; src.typ := OCT.chartyp; g := Char
  1096.       END;
  1097.       IF g IN lwordSet THEN OCC.Move (L, src, dst)
  1098.       ELSIF g IN wordSet THEN moveWL (src, dst, g = Int)
  1099.       ELSIF g IN byteSet THEN moveBL (src, dst, g = SInt)
  1100.       ELSE OCS.Mark (113)
  1101.       END
  1102.     |
  1103.     Bool :
  1104.       IF src.mode = Coc THEN
  1105.         IF (dst.mode = Reg) & (dst.a0 IN AdrRegs) THEN
  1106.           y := dst; OCC.GetDReg (dst, NIL)
  1107.         ELSE y.mode := Undef
  1108.         END;
  1109.         IF
  1110.           ((src.a1 = 0) & (src.a2 = 0)) OR (src.a0 IN {OCC.T, OCC.F})
  1111.         THEN
  1112.           op := OCC.Scc + (src.a0 * 100H); OCC.PutF3 (op, dst)
  1113.         ELSE
  1114.           op := OCC.Bcc + (OCC.invertedCC (src.a0) * 100H);
  1115.           OCC.PutWord (op); OCC.PutWord (src.a2);       (*    Bcc   1$    *)
  1116.           src.a2 := OCC.pc - 2; OCC.FixLink (src.a1);
  1117.           z := dst; OCC.PutF3 (OCC.ST, z);              (*    ST    <dst> *)
  1118.           L0 := OCC.pc; OCC.PutWord (6000H);            (*    BRA.S 2$    *)
  1119.           OCC.FixLink (src.a2);
  1120.           z := dst; OCC.PutF3 (OCC.SF, z);              (* 1$ SF    <dst> *)
  1121.           OCC.PatchWord (L0, OCC.pc - L0 - 2);          (* 2$             *)
  1122.         END;
  1123.         IF y.mode # Undef THEN
  1124.           OCC.Move (L, dst, y); OCI.Unload (dst) (*OCI.Unload (y)*)
  1125.         END
  1126.       ELSIF g = Bool THEN
  1127.         IF src.mode = Con THEN
  1128.           IF (dst.mode = Reg) & (dst.a0 IN AdrRegs) THEN
  1129.             y := dst; OCC.GetDReg (dst, NIL)
  1130.           ELSE y.mode := Undef
  1131.           END;
  1132.           IF src.a0 = 0 THEN op := OCC.SF ELSE op := OCC.ST END;
  1133.           OCC.PutF3 (op, dst);
  1134.           IF y.mode # Undef THEN
  1135.             OCC.Move (L, dst, y); OCI.Unload (dst) (*OCI.Unload (y)*)
  1136.           END
  1137.         ELSE
  1138.           OCC.Move (B, src, dst)
  1139.         END
  1140.       ELSE OCS.Mark (113)
  1141.       END
  1142.     |
  1143.     Char, SInt :
  1144.       IF (g = String) & (src.a1 <= 2) THEN
  1145.         src.a0 := src.a2; src.typ := OCT.chartyp; g := Char
  1146.       END;
  1147.       IF (g = f) OR (g = Byte) THEN OCC.Move (B, src, dst)
  1148.       ELSE OCS.Mark (113)
  1149.       END
  1150.     |
  1151.     Int :
  1152.       IF g IN {Int, Word} THEN OCC.Move (W, src, dst)
  1153.       ELSIF g = SInt THEN moveBW (src, dst, TRUE)
  1154.       ELSE OCS.Mark (113)
  1155.       END
  1156.     |
  1157.     LInt :
  1158.       IF g IN {LInt, Longword, AdrTyp} THEN OCC.Move (L, src, dst)
  1159.       ELSIF g = Int THEN moveWL (src, dst, TRUE)
  1160.       ELSIF g = SInt THEN moveBL (src, dst, TRUE)
  1161.       ELSE OCS.Mark (113)
  1162.       END
  1163.     |
  1164.     BSet, WSet, Set :
  1165.       IF g = f THEN OCC.Move (src.typ.size, src, dst)
  1166.       ELSIF (g IN {BSet, WSet, Set}) & (src.mode = Con) THEN
  1167.         IF (f = BSet) & ((src.a0 < -128) OR (src.a0 > 255)) THEN
  1168.           OCS.Mark (113)
  1169.         ELSIF (f = WSet) & ((src.a0 < -32768) OR (src.a0 > 65535)) THEN
  1170.           OCS.Mark (113)
  1171.         ELSE
  1172.           OCC.Move (dst.typ.size, src, dst)
  1173.         END
  1174.       ELSE OCS.Mark (113)
  1175.       END
  1176.     |
  1177.     Real :
  1178.       IF g = Real THEN OCC.Move (L, src, dst)
  1179.       ELSIF g IN intSet THEN IntToReal ()
  1180.       ELSE OCS.Mark (113)
  1181.       END
  1182.     |
  1183.     LReal :
  1184.       IF g = LReal THEN OCC.Move (L, src, dst)
  1185.       ELSIF g = Real THEN OCC.Move (L, src, dst)
  1186.       ELSIF g IN intSet THEN IntToReal ()
  1187.       ELSE OCS.Mark (113)
  1188.       END
  1189.     |
  1190.     Pointer :
  1191.       IF (dst.typ = src.typ) OR (g = NilTyp) THEN
  1192.         p := dst.typ.BaseTyp;
  1193.         IF p = NIL THEN OCS.Mark (966); HALT (966) END;
  1194.         IF p.form = DynArr THEN
  1195.           IF param THEN
  1196.             IF g = NilTyp THEN
  1197.               WHILE (p # NIL) & (p.form = DynArr) DO
  1198.                 OCC.Move (L, src, dst);
  1199.                 p := p.BaseTyp
  1200.               END;
  1201.             ELSIF src.mode = RList THEN
  1202.               ExtendStack (p.size); dst.mode := RegI; dst.a1 := 0;
  1203.             ELSE
  1204.               IF src.mode IN {Ind, IndX, RegI, RegX} THEN
  1205.                 INC (src.a1, p.adr)
  1206.               ELSE
  1207.                 INC (src.a0, p.adr)
  1208.               END;
  1209.               WHILE (p # NIL) & (p.form = DynArr) DO
  1210.                 OCC.Move (L, src, dst);
  1211.                 IF src.mode IN {Ind, IndX, RegI, RegX} THEN DEC (src.a1, 4)
  1212.                 ELSE DEC (src.a0, 4)
  1213.                 END;
  1214.                 p := p.BaseTyp
  1215.               END
  1216.             END;
  1217.             OCC.Move (L, src, dst)
  1218.           ELSE
  1219.             IF g = NilTyp THEN
  1220.               IF dst.mode = RList THEN
  1221.                 R1 := SYS.VAL (SET, dst.a0); reg := D0; dst.mode := Reg;
  1222.                 WHILE reg <= A7 DO
  1223.                   IF reg IN R1 THEN
  1224.                     dst.a0 := reg; OCC.Move (L, src, dst)
  1225.                   END;
  1226.                   INC (reg)
  1227.                 END
  1228.               ELSE
  1229.                 WHILE (p # NIL) & (p.form = DynArr) DO
  1230.                   OCC.Move (L, src, dst);
  1231.                   IF dst.mode IN {Ind, IndX, RegI, RegX} THEN INC (dst.a1, 4)
  1232.                   ELSE INC (dst.a0, 4)
  1233.                   END;
  1234.                   p := p.BaseTyp
  1235.                 END;
  1236.                 OCC.Move (L, src, dst)
  1237.               END
  1238.             ELSIF (src.mode = RList) OR (dst.mode = RList) THEN
  1239.               OCC.Move (L, src, dst)
  1240.             ELSE
  1241.               moveBlock (src, dst, dst.typ.size)
  1242.             END
  1243.           END;
  1244.         ELSE OCC.Move (L, src, dst)
  1245.         END
  1246.       ELSIF
  1247.         (g = Pointer) & (OCT.Tagged (src.typ) = OCT.Tagged (dst.typ))
  1248.       THEN
  1249.         p := dst.typ.BaseTyp; q := src.typ.BaseTyp;
  1250.         IF (p.form = Record) & (q.form = Record) THEN
  1251.           WHILE (q # p) & (q # NIL) DO q := q.BaseTyp END;
  1252.           IF q # NIL THEN movePtr (src, dst)
  1253.           ELSE OCS.Mark (113)
  1254.           END
  1255.         ELSE OCS.Mark (113)
  1256.         END
  1257.       ELSIF (g IN {AdrTyp, BPtrTyp}) & ~OCT.Tagged (dst.typ) THEN
  1258.         movePtr (src, dst)
  1259.       ELSE OCS.Mark (113)
  1260.       END
  1261.     |
  1262.     PtrTyp :
  1263.       IF
  1264.         ( (g = Pointer) & (src.typ.sysflg = OberonFlag)
  1265.           & (src.typ.BaseTyp # NIL) & (src.typ.BaseTyp.form # DynArr) )
  1266.         OR (g IN {PtrTyp, NilTyp})
  1267.       THEN
  1268.         OCC.Move (L, src, dst)
  1269.       ELSE OCS.Mark (113)
  1270.       END
  1271.     |
  1272.     AdrTyp :
  1273.       IF
  1274.         ((g = Pointer) & (src.typ.sysflg IN {M2Flag, CFlag, AsmFlag}))
  1275.         OR (g IN {AdrTyp, NilTyp})
  1276.       THEN
  1277.         movePtr (src, dst)
  1278.       ELSE OCS.Mark (113)
  1279.       END
  1280.     |
  1281.     BPtrTyp :
  1282.       IF
  1283.         ((g = Pointer) & (src.typ.sysflg = BCPLFlag))
  1284.         OR (g IN {BPtrTyp, NilTyp})
  1285.       THEN
  1286.         movePtr (src, dst)
  1287.       ELSE OCS.Mark (113)
  1288.       END
  1289.     |
  1290.     Array :
  1291.       IF dst.mode # Pointer THEN
  1292.         IF dst.typ = src.typ THEN
  1293.           moveBlock (src, dst, dst.typ.size)
  1294.         ELSIF (g = String) & (dst.typ.BaseTyp = OCT.chartyp) THEN
  1295.           freeDst := FALSE;
  1296.           IF dst.mode = Push THEN
  1297.             ExtendStack (dst.typ.size);
  1298.             y.mode := Reg; y.a0 := dst.a0;
  1299.             OCC.GetAReg (dst, NIL); OCC.Move (L, y, dst);
  1300.             dst.mode := RegI; dst.a1 := 0;
  1301.             freeDst := TRUE
  1302.           END;
  1303.           z.mode := Con; z.typ := OCT.inttyp; z.a0 := src.a1 - 1;
  1304.           vsz := dst.typ.n - 1; IF z.a0 > vsz THEN OCS.Mark (114) END;
  1305.           OCI.CopyString (src, dst, z);
  1306.           IF freeDst THEN OCC.FreeReg (dst) END
  1307.         ELSE
  1308.           OCS.Mark (113)
  1309.         END
  1310.       ELSE
  1311.         OCS.Mark (904)
  1312.       END
  1313.     |
  1314.     DynArr :
  1315.       IF param THEN (* formal parameter is open array *)
  1316.         IF dst.mode = Reg THEN
  1317.           (* Register parameter, address only *)
  1318.           IF
  1319.             (dst.typ.BaseTyp = OCT.bytetyp)
  1320.             OR ((g = String) & (dst.typ.BaseTyp.form = Char))
  1321.             OR ((g IN {Array, DynArr})
  1322.               & (src.typ.BaseTyp = dst.typ.BaseTyp))
  1323.           THEN
  1324.             IF (g = String) & (dst.typ.BaseTyp.form = Char) THEN
  1325.               IF src.a1 = 2 THEN OCC.AllocStringFromChar (src) END;
  1326.               IF src.a1 = 1 THEN (* Pass NIL for an empty string *)
  1327.                 src.mode := Con; src.a0 := 0; OCC.Move (L, src, dst)
  1328.               ELSE
  1329.                 OCI.MoveAdr (src, dst)
  1330.               END
  1331.             ELSE
  1332.               OCI.MoveAdr (src, dst)
  1333.             END;
  1334.           ELSE
  1335.             OCS.Mark (59)
  1336.           END
  1337.         ELSE
  1338.           IF (g = String) & (dst.typ.BaseTyp.form = Char) THEN
  1339.             Leng (dst, src.a1);
  1340.             IF src.a1 < 3 THEN OCC.AllocStringFromChar (src) END
  1341.           ELSIF src.mode >= Abs THEN
  1342.             OCS.Mark (59)
  1343.           ELSE
  1344.             DynArrBnd (dst.typ, src, FALSE)
  1345.           END;
  1346.           IF (g = DynArr) OR (src.mode IN {Ind, IndX}) THEN
  1347.             OCI.MoveAdr (src, dst)
  1348.           ELSE
  1349.             OCC.PutF3 (OCC.PEA, src)
  1350.           END
  1351.         END
  1352.       ELSE
  1353.         OCS.Mark (113)
  1354.       END
  1355.     |
  1356.     Record :
  1357.       (* IF (dst.mode = Reg) (*& (src.typ.size > PtrSize)*) THEN *)
  1358.         (* OCS.Mark (904) *)
  1359.       (* ELSE *)
  1360.         IF dst.typ # src.typ THEN
  1361.           IF g = Record THEN
  1362.             q := src.typ.BaseTyp;
  1363.             WHILE (q # NIL) & (q # dst.typ) DO q := q.BaseTyp END;
  1364.             IF q = NIL THEN OCS.Mark (113) END
  1365.           ELSE OCS.Mark (113)
  1366.           END
  1367.         END;
  1368.         IF
  1369.           (dst.typ.sysflg = OberonFlag)
  1370.           & OCS.pragma [OCS.typeChk] & ~param
  1371.           & ( ((dst.mode = Ind) OR (dst.mode = RegI))
  1372.               & (dst.obj = OCC.wasderef)
  1373.           (* p^ := *)
  1374.               OR (dst.mode = Ind) & (dst.obj # NIL)
  1375.               & (dst.obj # OCC.wasderef))
  1376.           (* varpar := *)
  1377.         THEN
  1378.           R := OCC.regState; tag := dst; tag.typ := OCT.tagtyp;
  1379.           IF dst.obj = OCC.wasderef THEN tag.a1 := -4
  1380.           ELSE tag.mode := Var; INC (tag.a0, 4)
  1381.           END;
  1382.           tdes.mode := Con; tdes.a0 := 0; tdes.a1 := 0;
  1383.           tdes.typ := OCT.tagtyp; tdes.label := dst.typ.label;
  1384.           OCI.Adr (tdes); OCI.CMP (L, tdes, tag);
  1385.           OCC.TrapCC (OCC.TypeCheck, OCC.NE);
  1386.           OCC.FreeRegs (R)
  1387.         END;
  1388.         moveBlock (src, dst, dst.typ.size)
  1389.       (* END *)
  1390.     |
  1391.     ProcTyp :
  1392.       IF (dst.typ = src.typ) OR (g = NilTyp) THEN
  1393.         IF (src.mode = XProc)
  1394.         OR ((OCM.SmallData OR OCM.Resident) & (src.mode = LProc))
  1395.         THEN
  1396.           OCI.MoveAdr (src, dst)
  1397.         ELSIF src.mode IN {LProc, TProc, LibCall, AProc, M2Proc, CProc} THEN
  1398.           OCS.Mark (119)
  1399.         ELSE OCC.Move (L, src, dst)
  1400.         END;
  1401.       ELSIF (src.mode = XProc)
  1402.          OR ((OCM.SmallData OR OCM.Resident) & (src.mode = LProc))
  1403.       THEN
  1404.         (* procedure dest to proc. variable, check compatibility *)
  1405.         IF dst.typ.BaseTyp = src.typ THEN
  1406.           CompareParLists (dst.typ.link, src.obj.link);
  1407.           OCI.MoveAdr (src, dst)
  1408.         ELSE OCS.Mark (118)
  1409.         END
  1410.       ELSIF src.mode IN {LProc, TProc, LibCall, AProc, M2Proc, CProc} THEN
  1411.         OCS.Mark (119)
  1412.       ELSE OCS.Mark (111)
  1413.       END
  1414.     |
  1415.     TagTyp :
  1416.       IF (f = g) OR (g = NilTyp) THEN OCC.Move (L, src, dst)
  1417.       ELSE OCS.Mark (111)
  1418.       END
  1419.     |
  1420.     NoTyp, NilTyp : OCS.Mark (111)
  1421.     |
  1422.   ELSE
  1423.     OCS.Mark (1016); OCS.Warn (f)
  1424.   END; (* CASE f *)
  1425.   OCC.ForgetObj (dst.obj);
  1426.   OCI.Unload (src)
  1427. END Assign;
  1428.  
  1429. (*------------------------------------*)
  1430. PROCEDURE RegsUsed ( fpar : OCT.Object ) : SET;
  1431.  
  1432.   VAR result : SET;
  1433.  
  1434. BEGIN (* RegsUsed *)
  1435.   result := {};
  1436.   WHILE (fpar # NIL) & OCT.IsParam (fpar) DO
  1437.     INCL (result, fpar.a0); fpar := fpar.link
  1438.   END;
  1439.   RETURN result
  1440. END RegsUsed;
  1441.  
  1442. (*------------------------------------*)
  1443. PROCEDURE PrepCall *
  1444.   ( VAR x    : OCT.Item;
  1445.     VAR fpar : OCT.Object;
  1446.     VAR mask : SET );
  1447.  
  1448.   VAR y : OCT.Item;
  1449.  
  1450. BEGIN (* PrepCall *)
  1451.   mask := OCC.AllRegs;
  1452.   IF x.mode IN {LProc, XProc, AProc, LibCall, M2Proc, CProc} THEN
  1453.     fpar := x.obj.link;
  1454.     IF x.mode IN {LibCall, AProc} THEN
  1455.       mask := OCC.ScratchRegs + RegsUsed (fpar);
  1456.       IF x.mode = LibCall THEN
  1457.         INCL (mask, A6)
  1458.       END
  1459.     END
  1460.   ELSIF x.mode = TProc THEN
  1461.     fpar := x.obj.link.link;
  1462.   ELSIF (x.typ # NIL) & (x.typ.form = ProcTyp) THEN
  1463.     fpar := x.typ.link
  1464.   ELSE
  1465.     OCS.Mark (121); fpar := NIL; x.typ := OCT.undftyp
  1466.   END
  1467. END PrepCall;
  1468.  
  1469. (* ---------------------------------- *)
  1470. PROCEDURE VarArgParam *
  1471.   ( VAR ap : OCT.Item;
  1472.     fpo    : OCT.Object;
  1473.     load   : BOOLEAN );
  1474.  
  1475.   VAR fp, reg : OCT.Item;
  1476.  
  1477. BEGIN (* VarArgParam *)
  1478.   fp.mode := Push; fp.a0 := A7; fp.typ := fpo.typ; fp.rdOnly := FALSE;
  1479.   Assign (fp, ap, TRUE);
  1480.   IF load THEN
  1481.     fp.mode := Reg; reg.mode := Reg; reg.a0 := fpo.a0;
  1482.     OCC.ReserveReg (reg.a0, NIL);
  1483.     OCC.Move (L, fp, reg)
  1484.   END;
  1485. END VarArgParam;
  1486.  
  1487. (*------------------------------------*)
  1488. PROCEDURE Param * (VAR ap : OCT.Item; fpo : OCT.Object; mode : INTEGER);
  1489.  
  1490.   VAR
  1491.     fp, t : OCT.Item; q : OCT.Struct; freeFp : BOOLEAN; f, g : INTEGER;
  1492.     s : LONGINT;
  1493.  
  1494. BEGIN (* Param *)
  1495.   IF mode IN {LibCall, AProc} THEN (* Register parameter *)
  1496.     fp.mode := Reg; fp.a0 := fpo.a0
  1497.   ELSE (* Stack parameter *)
  1498.     fp.mode := Push; fp.a0 := SP
  1499.   END;
  1500.   fp.typ := fpo.typ; fp.rdOnly := FALSE;
  1501.  
  1502.   f := fpo.typ.form; g := ap.typ.form;
  1503.   IF fpo.mode = Ind THEN (* VAR parameter *)
  1504.     IF ap.mode >= Con THEN OCS.Mark (122)
  1505.     ELSIF ap.rdOnly THEN OCS.Mark (324)
  1506.     END;
  1507.     IF fp.typ.form = DynArr THEN
  1508.       IF fp.mode = Reg THEN
  1509.         OCI.MoveAdr (ap, fp)
  1510.       ELSE
  1511.         IF mode # CProc THEN DynArrBnd (fp.typ, ap, TRUE) END;
  1512.         IF (ap.typ.form = DynArr) OR (ap.mode IN {Ind, IndX}) THEN
  1513.           OCI.MoveAdr (ap, fp)
  1514.         ELSE
  1515.           OCC.PutF3 (OCC.PEA, ap)
  1516.         END
  1517.       END
  1518.     ELSIF (fp.typ.form = Record) & (ap.typ.form = Record) THEN
  1519.       q := ap.typ; WHILE (q # fp.typ) & (q # NIL) DO q := q.BaseTyp END;
  1520.       IF q # NIL THEN
  1521.         IF (ap.mode = Ind) & (ap.obj # NIL) & (ap.obj # OCC.wasderef) THEN
  1522.           (* actual parameter is a VAR parameter *)
  1523.           ap.mode := Var;
  1524.           IF q.sysflg = OberonFlag THEN
  1525.             INC (ap.a0, 4); OCC.Move (L, ap, fp);
  1526.             IF ap.mode = Var THEN DEC (ap.a0, 4) ELSE DEC (ap.a1, 4) END;
  1527.           END;
  1528.           OCC.Move (L, ap, fp)
  1529.         ELSIF
  1530.           ((ap.mode = Ind) OR (ap.mode = RegI)) & (ap.obj = OCC.wasderef)
  1531.         THEN
  1532.           (* actual parameter is a dereferenced pointer *)
  1533.           IF q.sysflg = OberonFlag THEN
  1534.             ap.a1 := -4; OCC.Move (L, ap, fp);
  1535.             ap.a1 := 0;
  1536.           END;
  1537.           OCI.MoveAdr (ap, fp)
  1538.         ELSE
  1539.           IF q.sysflg = OberonFlag THEN
  1540.             t.mode := Con; t.a0 := 0; t.a1 := 0; t.typ := OCT.tagtyp;
  1541.             t.label := ap.typ.label;
  1542.             OCC.PutF3 (OCC.PEA, t)
  1543.           END;
  1544.           IF fp.mode = Reg THEN OCI.MoveAdr (ap, fp)
  1545.           ELSE OCC.PutF3 (OCC.PEA, ap)
  1546.           END
  1547.         END
  1548.       ELSE OCS.Mark (111)
  1549.       END
  1550.     ELSIF
  1551.       (ap.typ = fp.typ)
  1552.       OR ((f = Byte)     & (g IN {Char, SInt, BSet}))
  1553.       OR ((f = Word)     & (g IN wordSet))
  1554.       OR ((f = Longword) & (g IN lwordSet))
  1555.       OR ((f = PtrTyp)   & (g = Pointer) & (ap.typ.sysflg = OberonFlag))
  1556.       OR ((f = AdrTyp)  & (g = Pointer) & (ap.typ.sysflg IN {M2Flag, CFlag, AsmFlag}))
  1557.       OR ((f = BPtrTyp)  & (g = Pointer) & (ap.typ.sysflg = BCPLFlag))
  1558.     THEN
  1559.       IF (ap.mode IN {Ind, IndX}) OR (fp.mode = Reg) THEN
  1560.         OCI.MoveAdr (ap, fp)
  1561.       ELSE
  1562.         OCC.PutF3 (OCC.PEA, ap)
  1563.       END
  1564.     ELSE OCS.Mark (123)
  1565.     END;
  1566.     OCI.Unload (ap)
  1567.   ELSE
  1568.     Assign (fp, ap, TRUE);
  1569.   END;
  1570.   IF mode IN {LibCall, AProc} THEN (* Reserve parameter's register *)
  1571.     OCC.ReserveReg (fp.a0, NIL)
  1572.   END
  1573. END Param;
  1574.  
  1575. (*------------------------------------*)
  1576. PROCEDURE DeRef (VAR x : OCT.Item);
  1577.  
  1578.   VAR t1, t2 : OCT.Item;
  1579.  
  1580. BEGIN (* DeRef *)
  1581.   IF (x.mode <= RegX) & (x.typ.form = Pointer) THEN
  1582.     IF OCC.InAdrReg (x.obj) THEN
  1583.       OCC.GetAReg (x, x.obj); x.mode := RegI
  1584.     ELSE
  1585.       t1 := x; t1.obj := NIL; t1.typ := OCT.ptrtyp; OCC.GetAReg (x, x.obj);
  1586.       IF OCS.pragma [OCS.nilChk] THEN
  1587.         OCC.GetDReg (t2, NIL); OCC.Move (L, t1, t2);   (* MOVE.L  x,Dn   *)
  1588.         OCC.TrapCC (OCC.NilCheck, OCC.EQ);
  1589.         OCC.Move (L, t2, x); OCI.Unload (t2)           (* MOVEA.L Dn, An *)
  1590.       ELSE
  1591.         OCC.Move (L, t1, x);                           (* MOVEA.L x, An  *)
  1592.       END;
  1593.       x.mode := RegI
  1594.     END;
  1595.     x.typ := x.typ.BaseTyp; x.obj := OCC.wasderef; x.rdOnly := FALSE;
  1596.     x.a2 := 0
  1597.   ELSE
  1598.     OCS.Mark (84)
  1599.   END;
  1600.   x.a1 := 0
  1601. END DeRef;
  1602.  
  1603. (*------------------------------------*)
  1604. PROCEDURE Receiver *
  1605.   ( mode  : SHORTINT;
  1606.     VAR x : OCT.Item;
  1607.     rcvr  : OCT.Object;
  1608.     mask  : SET );
  1609.  
  1610.   VAR t1 : OCT.Item; R : OCC.RegState;
  1611.  
  1612. BEGIN (* Receiver *)
  1613.   IF mode = TProc THEN
  1614.     t1 := x;
  1615.     IF (t1.typ.form = Pointer) & (rcvr.mode = Ind) THEN DeRef (t1) END;
  1616.     R := OCC.regState; Param (t1, rcvr, TProc); OCC.regState.regs := R.regs
  1617.   ELSIF (OCM.SmallData OR OCM.Resident) & (A4 IN mask) THEN
  1618.     OCC.ReserveReg (A6, NIL);
  1619.     t1.mode := Reg; t1.a0 := A6; OCC.Move (L, x, t1);
  1620.   END;
  1621. END Receiver;
  1622.  
  1623. (*------------------------------------*)
  1624. PROCEDURE Call *
  1625.   ( VAR x, rcvr : OCT.Item;
  1626.     stackload   : LONGINT;
  1627.     mask        : SET );
  1628.  
  1629.   VAR y, z : OCT.Item; offset : LONGINT;
  1630.  
  1631. BEGIN (* Call *)
  1632.   IF x.mode = LProc THEN
  1633.     IF x.lev > 0 THEN
  1634.       y.mode := Var; y.typ := OCT.linttyp;
  1635.       IF x.lev = OCC.level THEN
  1636.         y.lev := x.lev; y.a0 := 0; OCC.PutF3 (OCC.PEA, y)
  1637.       ELSE
  1638.         y.lev := x.lev + 1; y.a0 := 8; z.mode := Push; z.a0 := SP;
  1639.         OCC.Move (L, y, z)
  1640.       END
  1641.     END;
  1642.     OCC.PutWord (OCC.BSR); OCC.PutWordRef (0, x.label)
  1643.   ELSIF x.mode IN {XProc, M2Proc, CProc, AProc} THEN
  1644.     IF OCM.SmallCode OR ((x.mode = XProc) & (x.lev = 0)) THEN
  1645.       OCC.PutWord (OCC.BSR); OCC.PutWordRef (0, x.label)
  1646.     ELSE
  1647.       OCC.PutF3 (OCC.JSR, x)
  1648.     END
  1649.   ELSIF x.mode = TProc THEN
  1650.     IF x.a2 < 0 THEN (* Super-call, call directly *)
  1651.       x.lev := -x.obj.link.typ.mno;
  1652.       IF OCM.SmallCode OR (x.lev = 0) THEN
  1653.         OCC.PutWord (OCC.BSR); OCC.PutWordRef (0, x.label)
  1654.       ELSE
  1655.         x.mode := XProc; OCC.PutF3 (OCC.JSR, x)
  1656.       END
  1657.     ELSE
  1658.       y := rcvr;
  1659.       IF y.typ.form = Pointer THEN DeRef (y) END;
  1660.       IF x.obj.a0 >= 0 THEN offset := x.obj.a0 * (-4)
  1661.       ELSE offset := x.obj.a2
  1662.       END;
  1663.       IF (y.mode IN {RegI, Ind}) & (y.obj = OCC.wasderef) THEN
  1664.         (* rcvr is dereferenced pointer *)
  1665.         OCC.GetAReg (z, NIL); y.a1 := -4; OCC.Move (L, y, z);
  1666.         y.mode := RegI; y.a0 := z.a0; y.a1 := offset; OCC.Move (L, y, z);
  1667.         IF offset >= 0 THEN x.obj.a2 := OCC.pc - 2 END;
  1668.         z.mode := RegI; z.a1 := 0; OCC.PutF3 (OCC.JSR, z)
  1669.       ELSIF (y.mode = Ind) & (y.obj # NIL) & (y.obj # OCC.wasderef) THEN
  1670.         (* rcvr is record variable parameter *)
  1671.         y.mode := Var; INC (y.a0, 4);
  1672.         OCC.GetAReg (z, NIL); OCC.Move (L, y, z);
  1673.         y.mode := RegI; y.a0 := z.a0; y.a1 := offset; OCC.Move (L, y, z);
  1674.         IF offset >= 0 THEN x.obj.a2 := OCC.pc - 2 END;
  1675.         z.mode := RegI; z.a1 := 0; OCC.PutF3 (OCC.JSR, z);
  1676.       ELSE
  1677.         (* rcvr is record variable *)
  1678.         x.lev := -x.obj.link.typ.mno;
  1679.         IF OCM.SmallCode OR (x.lev = 0) THEN
  1680.           OCC.PutWord (OCC.BSR); OCC.PutWordRef (0, x.label)
  1681.         ELSE
  1682.           x.mode := XProc; OCC.PutF3 (OCC.JSR, x)
  1683.         END
  1684.       END
  1685.     END
  1686.   ELSIF x.mode = LibCall THEN
  1687.     y.a0 := A6;
  1688.     IF ~((OCM.SmallData OR OCM.Resident) & (A4 IN mask)) THEN
  1689.       OCC.ReserveReg (A6, NIL);
  1690.       y.mode := Reg; OCC.Move (L, rcvr, y);
  1691.     END;
  1692.     OCC.UnReserveReg (A6);
  1693.     y.mode := RegI; y.a1 := x.a0; OCC.PutF3 (OCC.JSR, y)
  1694.   ELSIF (x.mode < Con) & (x.typ # OCT.undftyp) THEN (* procedure variable *)
  1695.     IF OCC.InAdrReg (x.obj) THEN
  1696.       OCC.GetAReg (x, x.obj)
  1697.     ELSE
  1698.       y := x; y.typ := OCT.ptrtyp; OCC.GetAReg (x, x.obj);
  1699.       IF OCS.pragma [OCS.nilChk] THEN
  1700.         OCI.Load (y);                             (*    MOVE.L  x,Dn      *)
  1701.         OCC.TrapCC (OCC.NilCheck, OCC.EQ)
  1702.       END;
  1703.       OCC.Move (L, y, x); OCI.Unload (y)
  1704.     END;
  1705.     x.mode := RegI; x.a1 := 0;
  1706.     OCC.PutF3 (OCC.JSR, x);
  1707.     x.typ := x.typ.BaseTyp
  1708.   ELSE
  1709.     OCS.Mark (121)
  1710.   END;
  1711.   IF x.mode IN {LibCall, CProc, AProc} THEN
  1712.     IF stackload > 0 THEN
  1713.       IF stackload <= 8 THEN
  1714.         y.mode := Reg; y.a0 := SP;
  1715.         OCC.PutF7 (OCC.ADDQ, L, stackload, y)
  1716.       ELSE
  1717.         y.mode := RegI; y.a0 := SP; y.a1 := stackload;
  1718.         OCC.PutF2 (OCC.LEA, y, SP)
  1719.       END
  1720.     END
  1721.   END
  1722. END Call;
  1723.  
  1724. (*------------------------------------*)
  1725. PROCEDURE Result * (VAR x : OCT.Item; typ : OCT.Struct);
  1726.  
  1727.   VAR res : OCT.Item; R : SET; reg : INTEGER;
  1728.  
  1729. BEGIN (* Result *)
  1730.   IF
  1731.     (typ.form = Pointer) & (typ.sysflg = OberonFlag)
  1732.     & (typ.BaseTyp # NIL) & (typ.BaseTyp.form = DynArr)
  1733.   THEN
  1734.     res.mode := RList; R := {}; reg := D0;
  1735.     WHILE (reg * 4) < typ.size DO INCL (R, reg); INC (reg) END;
  1736.     res.a0 := SYS.VAL (LONGINT, R)
  1737.   ELSE
  1738.     res.mode := Reg; res.a0 := D0
  1739.   END;
  1740.   res.typ := typ; res.rdOnly := FALSE;
  1741.   Assign (res, x, FALSE);
  1742.   returnFound := TRUE
  1743. END Result;
  1744.  
  1745. (*------------------------------------*)
  1746. PROCEDURE CaseIn * (VAR x : OCT.Item; VAR L0 : LONGINT);
  1747.  
  1748. BEGIN (* CaseIn *)
  1749.   IF ~(x.typ.form IN caseSet) THEN OCS.Mark (125) END;
  1750.   OCI.Load (x); OCC.UnReserveReg (x.a0); L0 := 0; FJ (L0)
  1751. END CaseIn;
  1752.  
  1753. (*------------------------------------*)
  1754. PROCEDURE CaseOut *
  1755.   ( VAR x : OCT.Item;
  1756.     L0, L1, L2 : LONGINT;
  1757.     n : INTEGER;
  1758.     VAR tab : ARRAY OF LabelRange);
  1759.  
  1760.   VAR labItem, y, z : OCT.Item; i : INTEGER; L3 : LONGINT;
  1761.  
  1762. BEGIN (* CaseOut *)
  1763.   labItem.mode := Con; labItem.typ := x.typ; i := 0;
  1764.   OCC.FixLink (L0); (* fixup jump from case expression *)
  1765.   WHILE i < n DO
  1766.     IF tab [i].low = tab [i].high THEN
  1767.       y := x; labItem.a0 := tab [i].low; OCE.Op (neq, y, labItem, FALSE);
  1768.       CBJ (y, tab [i].label)
  1769.     ELSE
  1770.       L3 := 0; y := x; labItem.a0 := tab [i].low;
  1771.       OCE.Op (geq, y, labItem, FALSE); CFJ (y, L3); z := x;
  1772.       labItem.a0 := tab [i].high; OCE.Op (gtr, z, labItem, FALSE);
  1773.       CBJ (z, tab [i].label); OCC.fixup (L3)
  1774.     END;
  1775.     INC (i)
  1776.   END;
  1777.   BJ (L2); (* jump to code for else part *)
  1778.   OCC.FixLink (L1); (* fixup jumps from individual cases *)
  1779. END CaseOut;
  1780.  
  1781. (*------------------------------------*)
  1782. PROCEDURE BeginFor *
  1783.   ( VAR control, low, high, step : OCT.Item;
  1784.     VAR R : OCC.RegState;
  1785.     VAR L0, L1 : LONGINT );
  1786.  
  1787.   VAR f, g, h, i : INTEGER; x, y : OCT.Item;
  1788.  
  1789. BEGIN (* BeginFor *)
  1790.   f := control.typ.form; g := low.typ.form; h := high.typ.form;
  1791.   i := step.typ.form;
  1792.   IF (f IN intSet) & (g IN intSet) & (h IN intSet) & (i IN intSet) THEN
  1793.     IF low.mode = Con THEN
  1794.       IF (f = Int) & (g = LInt) THEN OCS.Mark (317)
  1795.       ELSIF (f = SInt) & (g # SInt) THEN OCS.Mark (317)
  1796.       END;
  1797.       low.typ := control.typ
  1798.     END;
  1799.     IF high.mode = Con THEN
  1800.       IF (f = Int) & (h = LInt) THEN OCS.Mark (317)
  1801.       ELSIF (f = SInt) & (h # SInt) THEN OCS.Mark (317)
  1802.       END;
  1803.       high.typ := control.typ
  1804.     ELSE OCI.Load (high)
  1805.     END;
  1806.     IF (f = Int) & (i = LInt) THEN OCS.Mark (317)
  1807.     ELSIF (f = SInt) & (i # SInt) THEN OCS.Mark (317)
  1808.     END;
  1809.     step.typ := control.typ;
  1810.     IF (low.mode = Con) & (high.mode = Con) THEN
  1811.       IF (step.a0 > 0) & (high.a0 < low.a0) THEN OCS.Mark (318)
  1812.       ELSIF (step.a0 < 0) & (low.a0 < high.a0) THEN OCS.Mark (318)
  1813.       END
  1814.     END;
  1815.     x := control; Assign (x, low, FALSE);
  1816.     OCC.ForgetRegs; OCC.FreeRegs (R);
  1817.     IF high.mode = Reg THEN OCC.ReserveReg (high.a0, NIL) END;
  1818.     L0 := OCC.pc; x := control; y := high;
  1819.     IF high.mode = Con THEN
  1820.       IF step.a0 > 0 THEN OCE.Op (leq, x, y, FALSE);
  1821.       ELSE OCE.Op (geq, x, y, FALSE);
  1822.       END;
  1823.       CFJ (x, L1)
  1824.     ELSE
  1825.       IF step.a0 > 0 THEN OCE.Op (geq, y, x, FALSE);
  1826.       ELSE OCE.Op (leq, y, x, FALSE);
  1827.       END;
  1828.       CFJ (y, L1)
  1829.     END;
  1830.   END
  1831. END BeginFor;
  1832.  
  1833. (*------------------------------------*)
  1834. PROCEDURE EndFor *
  1835.   ( VAR control, step, high : OCT.Item; L0, L1 : LONGINT );
  1836.  
  1837. BEGIN (* EndFor *)
  1838.   IF step.a0 > 0 THEN OCC.PutF5 (OCC.ADD, step.typ.size, step, control)
  1839.   ELSE
  1840.     step.a0 := -step.a0; OCC.PutF5 (OCC.SUB, step.typ.size, step, control)
  1841.   END;
  1842.   (*IF OCS.overflowCheck THEN OCC.PutWord (OCC.TRAPV) END;*)
  1843.   BJ (L0); OCC.FixLink (L1);
  1844.   IF high.mode = Reg THEN OCC.UnReserveReg (high.a0) END;
  1845. END EndFor;
  1846.  
  1847. END OCH.
  1848.  
  1849. (***************************************************************************
  1850.  
  1851.   $Log: OCH.mod $
  1852.   Revision 5.26  1995/07/25  18:10:44  fjc
  1853.   - Fixed bug in module initialisation code. Small data model
  1854.     modules were *not* re-executable.
  1855.  
  1856.   Revision 5.25  1995/06/15  18:15:13  fjc
  1857.   - Fixed YARAB (Yet Another Register Allocation Bug)
  1858.     affecting type-bound procedures.
  1859.  
  1860.   Revision 5.24  1995/06/04  22:51:00  fjc
  1861.   - Fixed loading of A6 for library calls where A4 is used
  1862.     for parameters.
  1863.  
  1864.   Revision 5.23  1995/06/03  00:36:42  fjc
  1865.   - Amiga Library calls now load the base variable into A6
  1866.     *before* loading any parameters.
  1867.  
  1868.   Revision 5.22  1995/06/02  18:43:09  fjc
  1869.   - Implemented the SMALLDATA, RESIDENT and REGISTER options.
  1870.  
  1871.   Revision 5.22  1995/05/29  21:22:28  fjc
  1872.   - Various changes to support the SMALLDATA and RESIDENT
  1873.     options.
  1874.  
  1875.   Revision 5.21  1995/05/13  23:09:43  fjc
  1876.   - Changed INTEGER to LONGINT where necessary.
  1877.  
  1878.   Revision 5.20  1995/05/08  17:04:24  fjc
  1879.   - OCI.IsParam() --> OCT.IsParam()
  1880.  
  1881.   Revision 5.19  1995/04/23  17:59:39  fjc
  1882.   - Merging 5.26 & 5.27
  1883.  
  1884.   Revision 5.17  1995/04/02  13:53:40  fjc
  1885.   - Numerous changes to implement the small data model.
  1886.  
  1887.   Revision 5.16  1995/03/25  17:08:00  fjc
  1888.   - Added stripped-down version of OCE.DeRef() to be used
  1889.     by Receiver() and Call().
  1890.  
  1891.   Revision 5.15  1995/03/23  18:27:06  fjc
  1892.   - Modifications to Call(), BeginFor() and EndFor().
  1893.  
  1894.   Revision 5.14  1995/03/13  11:36:30  fjc
  1895.   - LibCalls now reserve the A6 register as a precaution,
  1896.     probably unnecessary.
  1897.  
  1898.   Revision 5.13  1995/03/09  19:12:00  fjc
  1899.   - Incorporated changes from 5.22.
  1900.  
  1901.   Revision 5.12  1995/02/27  17:08:00  fjc
  1902.   - Removed tracing code.
  1903.   - Implemented SMALLCODE option.
  1904.   - Changed to use new register handling procedures.
  1905.  
  1906.   Revision 5.11.1.1  1995/03/08  19:24:14  fjc
  1907.   - OC 5.22
  1908.  
  1909.   Revision 5.11  1995/01/26  00:17:17  fjc
  1910.   - Release 1.5
  1911.  
  1912.   Revision 5.10  1995/01/03  21:23:57  fjc
  1913.   - Changed OCG to OCM.
  1914.  
  1915.   Revision 5.9  1994/12/16  17:38:11  fjc
  1916.   - Changed Symbol to Label.
  1917.   - Changed Call() to generate a fixup list for calls to
  1918.     type-bound procedures which have not yet been allocated
  1919.     a slot.
  1920.  
  1921.   Revision 5.8  1994/11/13  11:35:10  fjc
  1922.   - Changed Assign() to make SYSTEM.PTR incompatible with
  1923.     POINTER TO ARRAY OF ...
  1924.  
  1925.   Revision 5.7  1994/10/23  16:26:35  fjc
  1926.   - Rewrote ModulePrologue() to call module Kernel's
  1927.     initialisation code.
  1928.   - All calls to the RTS are now through OCC.CallKernel().
  1929.   - Rewrote code for pointer assignments.
  1930.   - Fixed bug in code for procedure variable assignments.
  1931.   - Merged CallLibCall() and CallTypeBound() into Call().
  1932.  
  1933.   Revision 5.6  1994/09/25  18:05:21  fjc
  1934.   - Changed to reflect new object modes and system flags,
  1935.     espcially:
  1936.     - Merged Param() and RegParam().
  1937.     - Overhauled handling of pointer assignments.
  1938.  
  1939.   Revision 5.5  1994/09/19  23:10:05  fjc
  1940.   - Re-implemented Amiga library calls
  1941.  
  1942.   Revision 5.4  1994/09/15  19:43:51 (fnc
  1943.   - Merged in bug fix from 4.17.
  1944.  
  1945.   Revision 5.3  1994/09/15  10:40:23  fjc
  1946.   - Replaces switches with pragmas.
  1947.   - Implemented the EntryExitCode pragma and the INITIALISE
  1948.     and MAIN options.
  1949.  
  1950.   Revision 5.2  1994/09/08  10:52:07  fjc
  1951.   - Changed to use pragmas/options.
  1952.  
  1953.   Revision 5.1  1994/09/03  19:29:08  fjc
  1954.   - Bumped version number
  1955.  
  1956. ***************************************************************************)
  1957.